This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/C/write.c

1137 lines
29 KiB
C
Raw Normal View History

/*************************************************************************
2016-07-31 10:46:51 +01:00
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
2018-02-07 21:48:37 +00:00
* File: write.c * Last
*rev: * mods:
** comments: Writing a Prolog Term *
2016-07-31 10:46:51 +01:00
* *
*************************************************************************/
#ifdef SCCS
2015-02-10 00:03:02 +00:00
static char SccsId[] = "%W% %G%";
#endif
#include "Yap.h"
#include "YapHeap.h"
2015-09-21 23:05:36 +01:00
#include "YapText.h"
2016-03-29 01:55:12 +01:00
#include "Yatom.h"
2010-11-01 21:28:18 +00:00
#include "clause.h"
2016-03-29 01:55:12 +01:00
#include "yapio.h"
#include <math.h>
#include <stdlib.h>
#if COROUTINING
#include "attvar.h"
#endif
2015-06-19 01:30:13 +01:00
#include "iopreds.h"
#if HAVE_STRING_H
#include <string.h>
#endif
#if HAVE_CTYPE_H
#include <ctype.h>
#endif
#if HAVE_LOCALE_H
#include <locale.h>
#endif
/* describe the type of the previous term to have been written */
typedef enum {
2015-06-19 01:30:13 +01:00
start, /* initialization */
2015-02-10 00:03:02 +00:00
separator, /* the previous term was a separator like ',', ')', ... */
alphanum, /* the previous term was an atom or number */
symbol /* the previous term was a symbol like +, -, *, .... */
} wtype;
2015-10-22 00:45:21 +01:00
typedef StreamDesc *wrf;
2018-06-01 13:22:13 +01:00
typedef struct union_slots {
Int old;
Int ptr;
} uslots;
typedef struct union_direct {
Term old;
CELL *ptr;
} udirect;
typedef struct rewind_term {
struct rewind_term *parent;
union {
struct union_slots s;
struct union_direct d;
} u_sd;
} rwts;
typedef struct write_globs {
2015-06-19 01:30:13 +01:00
StreamDesc *stream;
2019-02-06 00:08:15 +00:00
bool Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays;
bool Keep_terms;
bool Write_Loops;
bool Write_strings;
UInt last_atom_minus;
2015-02-10 00:03:02 +00:00
UInt MaxDepth, MaxArgs;
wtype lw;
} wglbs;
#define lastw wglb->lw
2012-03-19 08:58:26 +00:00
#define last_minus wglb->last_atom_minus
2018-02-07 21:48:37 +00:00
static bool callPortray(Term t, int sno USES_REGS) {
2014-10-23 01:21:22 +01:00
PredEntry *pe;
2018-08-15 01:29:20 +01:00
Int b0 = LCL0 - (CELL *)B;
2014-10-23 01:21:22 +01:00
2015-07-06 11:59:50 +01:00
UNLOCK(GLOBAL_Stream[sno].streamlock);
2018-08-15 01:29:20 +01:00
if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorPortray, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, &t, true PASS_REGS)) {
choiceptr B0 = (choiceptr)(LCL0 - b0);
Yap_fail_all(B0 PASS_REGS);
2015-07-06 11:59:50 +01:00
LOCK(GLOBAL_Stream[sno].streamlock);
2014-10-23 01:21:22 +01:00
return true;
}
2015-07-06 11:59:50 +01:00
LOCK(GLOBAL_Stream[sno].streamlock);
2018-02-07 21:48:37 +00:00
2014-10-23 01:21:22 +01:00
return false;
}
2015-02-10 00:03:02 +00:00
2019-01-28 15:02:55 +00:00
#define PROTECT(t, F) \
{ \
yhandle_t yt = Yap_InitHandle(t); \
F; \
t = Yap_PopHandle(yt); \
2018-08-15 01:29:20 +01:00
}
2013-04-25 23:15:04 +01:00
static void wrputn(Int, struct write_globs *);
static void wrputf(Float, struct write_globs *);
static void wrputref(CODEADDR, int, struct write_globs *);
static int legalAtom(unsigned char *);
/*static int LeftOpToProtect(Atom, int);
static int RightOpToProtect(Atom, int);*/
static wtype AtomIsSymbols(unsigned char *);
static void putAtom(Atom, int, struct write_globs *);
2018-06-01 13:22:13 +01:00
static void writeTerm(Term, int, int, int, struct write_globs *,
struct rewind_term *);
2019-01-25 08:57:13 +00:00
2018-02-07 21:48:37 +00:00
#define wrputc(WF, X) \
2015-10-22 00:45:21 +01:00
(X)->stream_wputc(X - GLOBAL_Stream, WF) /* writes a character */
/*
protect bracket from merging with previoous character.
avoid stuff like not (2,3) -> not(2,3) or
2014-05-15 01:11:26 +01:00
*/
2015-02-10 00:03:02 +00:00
static void wropen_bracket(struct write_globs *wglb, int protect) {
2015-06-19 01:30:13 +01:00
StreamDesc *stream = wglb->stream;
2012-03-19 08:58:26 +00:00
2014-05-15 01:11:26 +01:00
if (lastw != separator && protect)
wrputc(' ', stream);
2015-02-10 00:03:02 +00:00
wrputc('(', stream);
2014-05-15 01:11:26 +01:00
lastw = separator;
}
2015-02-10 00:03:02 +00:00
static void wrclose_bracket(struct write_globs *wglb, int protect) {
2014-05-15 01:11:26 +01:00
wrf stream = wglb->stream;
2015-02-10 00:03:02 +00:00
wrputc(')', stream);
2014-05-15 01:11:26 +01:00
lastw = separator;
}
2015-02-10 00:03:02 +00:00
static int protect_open_number(struct write_globs *wglb, int lm,
int minus_required) {
2014-05-15 01:11:26 +01:00
wrf stream = wglb->stream;
if (lastw == symbol && lm && !minus_required) {
wropen_bracket(wglb, TRUE);
return TRUE;
2015-02-10 00:03:02 +00:00
} else if (lastw == alphanum || (lastw == symbol && minus_required)) {
wrputc(' ', stream);
}
2014-05-15 01:11:26 +01:00
return FALSE;
2012-03-19 08:58:26 +00:00
}
2015-02-10 00:03:02 +00:00
static void protect_close_number(struct write_globs *wglb, int used_bracket) {
2014-05-15 01:11:26 +01:00
if (used_bracket) {
wrclose_bracket(wglb, TRUE);
} else {
lastw = alphanum;
}
last_minus = FALSE;
2012-03-19 08:58:26 +00:00
}
2015-02-10 00:03:02 +00:00
static void wrputn(Int n,
struct write_globs *wglb) /* writes an integer */
{
2014-05-15 01:11:26 +01:00
wrf stream = wglb->stream;
2015-02-10 00:03:02 +00:00
char s[256], *s1 = s; /* that should be enough for most integers */
2014-05-15 01:11:26 +01:00
int has_minus = (n < 0);
int ob;
2012-03-19 08:58:26 +00:00
2014-05-15 01:11:26 +01:00
ob = protect_open_number(wglb, last_minus, has_minus);
#if HAVE_SNPRINTF
2014-05-15 01:11:26 +01:00
snprintf(s, 256, Int_FORMAT, n);
#else
2014-05-15 01:11:26 +01:00
sprintf(s, Int_FORMAT, n);
#endif
2014-05-15 01:11:26 +01:00
while (*s1)
wrputc(*s1++, stream);
protect_close_number(wglb, ob);
}
2018-08-15 01:29:20 +01:00
inline static void wrputs(char *s, StreamDesc *stream) {
int c;
while ((c = *s++))
wrputc(c, stream);
}
2010-05-27 12:24:15 +01:00
#ifdef USE_GMP
2015-02-10 00:03:02 +00:00
static char *ensure_space(size_t sz) {
2014-05-15 01:11:26 +01:00
CACHE_REGS
2018-02-07 21:48:37 +00:00
char *s;
2010-05-27 12:24:15 +01:00
2015-02-10 00:03:02 +00:00
s = (char *)Yap_PreAllocCodeSpace();
while (s + sz >= (char *)AuxSp) {
2010-05-27 12:24:15 +01:00
#if USE_SYSTEM_MALLOC
2014-05-15 01:11:26 +01:00
/* may require stack expansion */
if (!Yap_ExpandPreAllocCodeSpace(sz, NULL, TRUE)) {
s = NULL;
break;
}
2015-02-10 00:03:02 +00:00
s = (char *)Yap_PreAllocCodeSpace();
2010-05-27 12:24:15 +01:00
#else
2014-05-15 01:11:26 +01:00
s = NULL;
2010-05-27 12:24:15 +01:00
#endif
2014-05-15 01:11:26 +01:00
}
if (!s) {
s = (char *)TR;
2015-02-10 00:03:02 +00:00
while (s + sz >= LOCAL_TrailTop) {
if (!Yap_growtrail(sz / sizeof(CELL), FALSE)) {
s = NULL;
break;
2014-05-15 01:11:26 +01:00
}
s = (char *)TR;
}
}
if (!s) {
s = (char *)HR;
2015-02-10 00:03:02 +00:00
if (s + sz >= (char *)ASP) {
2015-09-25 10:57:26 +01:00
Yap_Error(RESOURCE_ERROR_STACK, TermNil,
2015-02-10 00:03:02 +00:00
"not enough space to write bignum: it requires %d bytes", sz);
2014-05-15 01:11:26 +01:00
s = NULL;
}
}
return s;
2010-05-27 12:24:15 +01:00
}
2015-02-10 00:03:02 +00:00
static void write_mpint(MP_INT *big, struct write_globs *wglb) {
2014-05-15 01:11:26 +01:00
char *s;
int has_minus = mpz_sgn(big);
int ob;
2015-02-10 00:03:02 +00:00
s = ensure_space(3 + mpz_sizeinbase(big, 10));
2014-05-15 01:11:26 +01:00
ob = protect_open_number(wglb, last_minus, has_minus);
if (!s) {
s = mpz_get_str(NULL, 10, big);
if (!s)
return;
2015-02-10 00:03:02 +00:00
wrputs(s, wglb->stream);
2014-05-15 01:11:26 +01:00
free(s);
} else {
mpz_get_str(s, 10, big);
2015-02-10 00:03:02 +00:00
wrputs(s, wglb->stream);
2014-05-15 01:11:26 +01:00
}
protect_close_number(wglb, ob);
2010-05-27 12:24:15 +01:00
}
#endif
2015-02-10 00:03:02 +00:00
/* writes a bignum */
static void writebig(Term t, int p, int depth, int rinfixarg,
2018-06-01 13:22:13 +01:00
struct write_globs *wglb, struct rewind_term *rwt) {
2015-02-10 00:03:02 +00:00
CELL *pt = RepAppl(t) + 1;
2014-05-15 01:11:26 +01:00
CELL big_tag = pt[0];
if (big_tag == ARRAY_INT || big_tag == ARRAY_FLOAT) {
wrputc('{', wglb->stream);
wrputs("...", wglb->stream);
wrputc('}', wglb->stream);
lastw = separator;
return;
#ifdef USE_GMP
2015-02-10 00:03:02 +00:00
} else if (big_tag == BIG_INT) {
2014-05-15 01:11:26 +01:00
MP_INT *big = Yap_BigIntOfTerm(t);
write_mpint(big, wglb);
return;
} else if (big_tag == BIG_RATIONAL) {
Term trat = Yap_RatTermToApplTerm(t);
2019-01-28 15:02:55 +00:00
writeTerm(trat, p, depth, rinfixarg, wglb, rwt);
2014-05-15 01:11:26 +01:00
return;
2010-05-27 12:24:15 +01:00
#endif
2014-05-15 01:11:26 +01:00
} else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) {
2017-07-30 21:53:07 +01:00
YAP_Opaque_CallOnWrite f;
2014-05-15 01:11:26 +01:00
CELL blob_info;
2017-11-08 09:29:01 +00:00
blob_info = big_tag;
2014-05-15 01:11:26 +01:00
if (GLOBAL_OpaqueHandlers &&
2015-02-10 00:03:02 +00:00
(f = GLOBAL_OpaqueHandlers[blob_info].write_handler)) {
2018-08-15 01:29:20 +01:00
(f)(wglb->stream->file, big_tag, ExternalBlobFromTerm(t), 0);
2014-05-15 01:11:26 +01:00
return;
}
}
2015-02-10 00:03:02 +00:00
wrputs("0", wglb->stream);
}
static void wrputf(Float f, struct write_globs *wglb) /* writes a float */
2010-05-27 12:24:15 +01:00
{
2015-06-19 01:30:13 +01:00
#if THREADS
2015-10-22 00:45:21 +01:00
char s[256];
2015-06-19 01:30:13 +01:00
#endif
2015-10-22 00:45:21 +01:00
wrf stream = wglb->stream;
2014-05-15 01:11:26 +01:00
int sgn;
int ob;
#if HAVE_ISNAN || defined(__WIN32)
2014-05-15 01:11:26 +01:00
if (isnan(f)) {
wrputs("(nan)", stream);
lastw = separator;
return;
}
#endif
2015-02-10 00:03:02 +00:00
sgn = (f < 0.0);
#if HAVE_ISINF || defined(_WIN32)
2014-05-15 01:11:26 +01:00
if (isinf(f)) {
if (sgn) {
wrputs("(-inf)", stream);
} else {
wrputs("(+inf)", stream);
}
lastw = separator;
return;
}
#endif
2014-05-15 01:11:26 +01:00
ob = protect_open_number(wglb, last_minus, sgn);
#if THREADS
2014-05-15 01:11:26 +01:00
/* old style writing */
int found_dot = FALSE;
2015-02-10 00:03:02 +00:00
char *pt = s;
2014-05-15 01:11:26 +01:00
int ch;
2016-07-31 10:46:51 +01:00
/* always use C locale for writing numbers */
#if O_LOCALE
2015-02-10 00:03:02 +00:00
const unsigned char *decimalpoint =
2018-02-07 21:48:37 +00:00
(unsigned char *)localeconv()->decimal_point;
2015-02-10 00:03:02 +00:00
size_t l1 = strlen((const char *)decimalpoint + 1);
#else
const unsigned char decimalpoint[2] = ".";
2014-06-11 19:30:44 +01:00
size_t l1 = 0;
#endif
2014-05-15 01:11:26 +01:00
if (lastw == symbol || lastw == alphanum) {
wrputc(' ', stream);
}
lastw = alphanum;
// sprintf(s, "%.15g", f);
2015-11-05 16:35:25 +00:00
sprintf(s, floatFormat(), f);
2014-05-15 01:11:26 +01:00
while (*pt == ' ')
pt++;
if (*pt == '-') {
wrputc('-', stream);
pt++;
}
while ((ch = *pt) != '\0') {
// skip locale
2015-02-10 00:03:02 +00:00
if (ch == decimalpoint[0] &&
!strncmp(pt + 1, (char *)decimalpoint + 1, l1)) {
2014-05-15 01:11:26 +01:00
found_dot = TRUE;
pt += l1;
ch = '.';
}
if (ch == 'e' || ch == 'E') {
if (!found_dot) {
found_dot = TRUE;
2015-02-10 00:03:02 +00:00
wrputs(".0", stream);
2014-05-15 01:11:26 +01:00
}
2018-05-14 16:03:02 +01:00
found_dot = true;
2014-05-15 01:11:26 +01:00
}
wrputc(ch, stream);
pt++;
}
if (!found_dot) {
wrputs(".0", stream);
}
#else
2015-06-19 01:30:13 +01:00
char buf[256];
2014-05-15 01:11:26 +01:00
if (lastw == symbol || lastw == alphanum) {
wrputc(' ', stream);
}
/* use SWI's format_float */
2015-10-22 00:45:21 +01:00
sprintf(buf, (char *)floatFormat(), f);
2015-06-19 01:30:13 +01:00
2014-05-15 01:11:26 +01:00
wrputs(buf, stream);
#endif
2014-05-15 01:11:26 +01:00
protect_close_number(wglb, ob);
}
2015-10-22 00:45:21 +01:00
int Yap_FormatFloat(Float f, char **s, size_t sz) {
CACHE_REGS
2018-02-07 21:48:37 +00:00
struct write_globs wglb;
2015-10-22 00:45:21 +01:00
int sno;
2019-01-28 15:02:55 +00:00
sno = Yap_open_buf_write_stream(GLOBAL_Stream[LOCAL_c_output_stream].encoding,
0);
2015-10-22 00:45:21 +01:00
if (sno < 0)
2017-01-09 14:58:01 +00:00
return false;
2016-04-18 16:38:29 +01:00
wglb.lw = separator;
2015-10-22 00:45:21 +01:00
wglb.stream = GLOBAL_Stream + sno;
wrputf(f, &wglb);
2018-07-13 12:27:58 +01:00
*s = Yap_MemExportStreamPtr(sno);
2015-10-22 00:45:21 +01:00
Yap_CloseStream(sno);
2017-01-09 14:58:01 +00:00
return true;
}
/* writes a data base reference */
2015-02-10 00:03:02 +00:00
static void wrputref(CODEADDR ref, int Quote_illegal,
2018-02-07 21:48:37 +00:00
struct write_globs *wglb) {
char s[256];
wrf stream = wglb->stream;
2018-02-07 21:48:37 +00:00
putAtom(AtomDBref, Quote_illegal, wglb);
2010-01-21 15:05:01 +00:00
#if defined(__linux__) || defined(__APPLE__)
2018-02-07 21:48:37 +00:00
sprintf(s, "(%p," UInt_FORMAT ")", ref, ((LogUpdClause *)ref)->ClRefCount);
#else
2018-02-07 21:48:37 +00:00
sprintf(s, "(0x%p," UInt_FORMAT ")", ref, ((LogUpdClause *)ref)->ClRefCount);
#endif
2018-02-07 21:48:37 +00:00
wrputs(s, stream);
lastw = alphanum;
}
2018-02-07 21:48:37 +00:00
/* writes a blob (default) */
static int wrputblob(AtomEntry *ref, int Quote_illegal,
struct write_globs *wglb) {
wrf stream = wglb->stream;
int rc;
int Yap_write_blob(AtomEntry * ref, StreamDesc * stream);
2015-10-22 00:45:21 +01:00
2018-02-07 21:48:37 +00:00
if ((rc = Yap_write_blob(ref, stream))) {
return rc;
2015-10-22 00:45:21 +01:00
}
2018-02-07 21:48:37 +00:00
lastw = alphanum;
return 1;
}
2012-02-27 08:53:18 +00:00
2018-02-07 21:48:37 +00:00
static int legalAtom(unsigned char *s) /* Is this a legal atom ? */
{
wchar_t ch = *s;
if (ch == '\0')
return FALSE;
if (Yap_chtype[ch] != LC) {
if (ch == '[') {
return (s[1] == ']' && !s[2]);
} else if (ch == '{') {
return (s[1] == '}' && !s[2]);
} else if (Yap_chtype[ch] == SL) {
return (!s[1]);
} else if (ch == '`') {
return false;
} else if ((ch == ',' || ch == '.') && !s[1]) {
return false;
} else {
if (ch == '/') {
if (s[1] == '*')
return false;
2014-05-15 01:11:26 +01:00
}
2018-02-07 21:48:37 +00:00
while (ch) {
if (Yap_chtype[ch] != SY) {
return false;
}
ch = *++s;
}
}
2016-01-03 02:06:09 +00:00
return true;
2018-02-07 21:48:37 +00:00
} else
while ((ch = *++s) != 0)
if (Yap_chtype[ch] > NU)
return false;
return true;
}
2018-02-07 21:48:37 +00:00
static wtype
AtomIsSymbols(unsigned char *s) /* Is this atom just formed by symbols ? */
{
int ch;
if (Yap_chtype[(int)s[0]] == SL && s[1] == '\0')
return (separator);
while ((ch = *s++) != '\0') {
if (Yap_chtype[ch] != SY)
return alphanum;
2017-09-23 02:17:55 +01:00
}
2018-02-07 21:48:37 +00:00
return symbol;
}
2017-09-23 02:17:55 +01:00
2018-02-07 21:48:37 +00:00
static void write_quoted(wchar_t ch, wchar_t quote, wrf stream) {
CACHE_REGS
if (!(Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE)) {
wrputc(ch, stream);
if (ch == '\'')
wrputc('\'', stream); /* be careful about quotes */
return;
2018-02-07 21:48:37 +00:00
}
if (!(ch < 0xff && chtype(ch) == BS) && ch != '\'' && ch != '\\' &&
ch != '`') {
wrputc(ch, stream);
} else {
switch (ch) {
case '\\':
wrputc('\\', stream);
wrputc('\\', stream);
break;
case '\'':
if (ch == quote)
wrputc('\\', stream);
2015-02-10 00:03:02 +00:00
wrputc(ch, stream);
2018-02-07 21:48:37 +00:00
break;
case '"':
if (ch == quote)
wrputc('\\', stream);
wrputc(ch, stream);
break;
case '`':
if (ch == quote)
wrputc('`', stream);
wrputc(ch, stream);
break;
case 7:
wrputc('\\', stream);
wrputc('a', stream);
break;
case '\b':
wrputc('\\', stream);
wrputc('b', stream);
break;
case '\t':
wrputc('\\', stream);
wrputc('t', stream);
break;
case ' ':
case 160:
wrputc(' ', stream);
break;
case '\n':
wrputc('\\', stream);
wrputc('n', stream);
break;
case 11:
wrputc('\\', stream);
wrputc('v', stream);
break;
case '\r':
wrputc('\\', stream);
wrputc('r', stream);
break;
case '\f':
wrputc('\\', stream);
wrputc('f', stream);
break;
default:
if (ch <= 0xff) {
char esc[8];
2015-02-10 00:03:02 +00:00
2018-02-07 21:48:37 +00:00
/* last backslash in ISO mode */
sprintf(esc, "\\%03o\\", ch);
wrputs(esc, stream);
2014-05-15 01:11:26 +01:00
}
}
}
2018-02-07 21:48:37 +00:00
}
2018-02-07 21:48:37 +00:00
static void write_string(const unsigned char *s,
struct write_globs *wglb) /* writes an integer */
{
StreamDesc *stream = wglb->stream;
utf8proc_int32_t chr, qt;
unsigned char *ptr = (unsigned char *)s;
if (wglb->Write_strings)
qt = '`';
else
qt = '"';
wrputc(qt, stream);
do {
int delta;
ptr += (delta = get_utf8(ptr, -1, &chr));
if (chr == '\0') {
break;
}
if (delta == 0) {
chr = *ptr++;
}
write_quoted(chr, qt, stream);
} while (true);
wrputc(qt, stream);
}
2013-12-05 21:26:05 +00:00
2018-02-07 21:48:37 +00:00
/* writes an atom */
static void putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb) {
unsigned char *s;
wtype atom_or_symbol;
wrf stream = wglb->stream;
2019-02-10 00:18:08 +00:00
if (atom == NULL) return;
s = RepAtom(atom)->UStrOfAE;
2019-02-15 13:50:24 +00:00
if (s[0] == '\0') {
if (Quote_illegal) {
wrputc('\'', stream);
wrputc('\'', stream);
}
2019-02-10 00:18:08 +00:00
return;
2019-02-15 13:50:24 +00:00
}
2018-02-07 21:48:37 +00:00
if (IsBlob(atom)) {
wrputblob(RepAtom(atom), Quote_illegal, wglb);
return;
}
/* #define CRYPT_FOR_STEVE 1*/
2012-02-27 08:53:18 +00:00
#ifdef CRYPT_FOR_STEVE
2018-02-07 21:48:37 +00:00
if (Yap_GetValue(AtomCryptAtoms) != TermNil &&
Yap_GetAProp(atom, OpProperty) == NIL) {
char s[16];
sprintf(s, "x%x", (CELL)s);
wrputs(s, stream);
return;
}
2012-02-27 08:53:18 +00:00
#endif
2018-02-07 21:48:37 +00:00
/* if symbol then last_minus is important */
last_minus = FALSE;
atom_or_symbol = AtomIsSymbols(s);
if (lastw == atom_or_symbol && atom_or_symbol != separator /* solo */)
wrputc(' ', stream);
lastw = atom_or_symbol;
if (Quote_illegal && !legalAtom(s)) {
wrputc('\'', stream);
while (*s) {
int32_t ch;
s += get_utf8(s, -1, &ch);
write_quoted(ch, '\'', stream);
2014-05-15 01:11:26 +01:00
}
2018-02-07 21:48:37 +00:00
wrputc('\'', stream);
} else {
wrputs((char *)s, stream);
2014-05-15 01:11:26 +01:00
}
2018-02-07 21:48:37 +00:00
}
2018-02-07 21:48:37 +00:00
void Yap_WriteAtom(StreamDesc *s, Atom atom) {
struct write_globs wglb;
wglb.stream = s;
wglb.Quote_illegal = FALSE;
putAtom(atom, 0, &wglb);
}
static int IsCodesTerm(Term string) /* checks whether this is a string */
{
if (IsVarTerm(string))
return FALSE;
do {
Term hd;
int ch;
2014-05-15 01:11:26 +01:00
2018-02-07 21:48:37 +00:00
if (!IsPairTerm(string))
return (FALSE);
hd = HeadOfTerm(string);
if (IsVarTerm(hd))
return (FALSE);
if (!IsIntTerm(hd))
return (FALSE);
ch = IntOfTerm(HeadOfTerm(string));
if ((ch < ' ' || ch > MAX_ISO_LATIN1) && ch != '\n' && ch != '\t')
return (FALSE);
string = TailOfTerm(string);
2015-02-10 00:03:02 +00:00
if (IsVarTerm(string))
2018-02-07 21:48:37 +00:00
return (FALSE);
} while (string != TermNil);
return (TRUE);
}
/* writes a string */
static void putString(Term string, struct write_globs *wglb)
{
wrf stream = wglb->stream;
wrputc('"', stream);
while (string != TermNil) {
wchar_t ch = IntOfTerm(HeadOfTerm(string));
write_quoted(ch, '"', stream);
string = TailOfTerm(string);
2014-05-15 01:11:26 +01:00
}
2018-02-07 21:48:37 +00:00
wrputc('"', stream);
lastw = alphanum;
}
2018-02-07 21:48:37 +00:00
/* writes a string */
static void putUnquotedString(Term string, struct write_globs *wglb)
2015-02-10 00:03:02 +00:00
2018-02-07 21:48:37 +00:00
{
wrf stream = wglb->stream;
while (string != TermNil) {
int ch = IntOfTerm(HeadOfTerm(string));
wrputc(ch, stream);
string = TailOfTerm(string);
2014-05-15 01:11:26 +01:00
}
2018-02-07 21:48:37 +00:00
lastw = alphanum;
}
2018-06-01 13:22:13 +01:00
static void write_var(CELL *t, struct write_globs *wglb,
struct rewind_term *rwt) {
2018-02-07 21:48:37 +00:00
CACHE_REGS
if (lastw == alphanum) {
wrputc(' ', wglb->stream);
}
wrputc('_', wglb->stream);
/* make sure we don't get no creepy spaces where they shouldn't be */
lastw = separator;
if (IsAttVar(t)) {
Int vcount = (t - H0);
if (wglb->Portray_delays) {
exts ext = ExtFromCell(t);
2018-06-01 13:22:13 +01:00
struct rewind_term nrwt;
nrwt.parent = rwt;
2018-08-15 01:29:20 +01:00
nrwt.u_sd.s.ptr = 0;
2018-02-07 21:48:37 +00:00
wglb->Portray_delays = FALSE;
if (ext == attvars_ext) {
attvar_record *attv = RepAttVar(t);
2018-08-15 01:29:20 +01:00
CELL *l = &attv->Value; /* dirty low-level hack, check atts.h */
2018-02-07 21:48:37 +00:00
wrputs("$AT(", wglb->stream);
2018-06-01 13:22:13 +01:00
write_var(t, wglb, rwt);
2018-02-07 21:48:37 +00:00
wrputc(',', wglb->stream);
2019-01-28 15:02:55 +00:00
PROTECT(*t, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt));
2018-10-25 18:03:54 +01:00
attv = RepAttVar(t);
wrputc(',', wglb->stream);
2018-08-15 01:29:20 +01:00
l++;
2019-01-25 08:57:13 +00:00
writeTerm(*l, 999, 1, FALSE, wglb, &nrwt);
2018-02-07 21:48:37 +00:00
wrclose_bracket(wglb, TRUE);
2016-07-31 10:46:51 +01:00
}
2018-02-07 21:48:37 +00:00
wglb->Portray_delays = TRUE;
return;
2014-05-15 01:11:26 +01:00
}
2018-02-07 21:48:37 +00:00
wrputc('D', wglb->stream);
wrputn(vcount, wglb);
} else {
wrputn(((Int)(t - H0)), wglb);
2017-09-23 02:17:55 +01:00
}
2018-02-07 21:48:37 +00:00
}
2009-05-22 18:24:30 +01:00
2019-01-28 15:02:55 +00:00
static void write_list(Term t, int direction, int depth,
2018-06-01 13:22:13 +01:00
struct write_globs *wglb, struct rewind_term *rwt) {
Term ti;
struct rewind_term nrwt;
nrwt.parent = rwt;
2018-08-15 01:29:20 +01:00
nrwt.u_sd.s.ptr = 0;
2018-02-07 21:48:37 +00:00
while (1) {
2018-08-15 01:29:20 +01:00
2018-10-25 18:03:54 +01:00
PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
2018-08-10 03:40:56 +01:00
ti = TailOfTerm(t);
2018-08-15 01:29:20 +01:00
if (IsVarTerm(ti))
break;
if (!IsPairTerm(ti))
break;
2018-02-07 21:48:37 +00:00
if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) {
if (lastw == symbol || lastw == separator) {
2018-08-15 01:29:20 +01:00
wrputc(' ', wglb->stream);
}
2018-02-07 21:48:37 +00:00
wrputc('|', wglb->stream);
putAtom(Atom3Dots, wglb->Quote_illegal, wglb);
return;
}
2014-05-15 01:11:26 +01:00
lastw = separator;
2018-02-07 21:48:37 +00:00
depth++;
wrputc(',', wglb->stream);
2018-08-15 01:29:20 +01:00
t = ti;
2018-08-10 03:40:56 +01:00
}
2018-08-15 01:29:20 +01:00
if (IsPairTerm(ti)) {
/* we found an infinite loop */
2018-10-25 18:03:54 +01:00
/* keep going on the list */
wrputc(',', wglb->stream);
2019-01-27 11:05:20 +00:00
write_list(ti, direction, depth, wglb, &nrwt);
2018-08-15 01:29:20 +01:00
} else if (ti != MkAtomTerm(AtomNil)) {
2018-02-07 21:48:37 +00:00
if (lastw == symbol || lastw == separator) {
wrputc(' ', wglb->stream);
2016-03-29 01:55:12 +01:00
}
2018-02-07 21:48:37 +00:00
wrputc('|', wglb->stream);
lastw = separator;
2019-01-27 11:05:20 +00:00
writeTerm(ti, 999, depth, FALSE, wglb, &nrwt);
2014-05-15 01:11:26 +01:00
}
2018-02-07 21:48:37 +00:00
}
2019-01-28 15:02:55 +00:00
static void writeTerm(Term t, int p, int depth, int rinfixarg,
struct write_globs *wglb, struct rewind_term *rwt)
2018-02-07 21:48:37 +00:00
/* term to write */
/* context priority */
{
CACHE_REGS
2019-01-28 15:02:55 +00:00
struct rewind_term nrwt;
nrwt.parent = rwt;
nrwt.u_sd.s.ptr = 0;
2018-02-07 21:48:37 +00:00
if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) {
putAtom(Atom3Dots, wglb->Quote_illegal, wglb);
return;
}
t = Deref(t);
if (IsVarTerm(t)) {
2018-06-01 13:22:13 +01:00
write_var((CELL *)t, wglb, &nrwt);
2018-02-07 21:48:37 +00:00
} else if (IsIntTerm(t)) {
2018-08-15 01:29:20 +01:00
2018-02-07 21:48:37 +00:00
wrputn((Int)IntOfTerm(t), wglb);
} else if (IsAtomTerm(t)) {
putAtom(AtomOfTerm(t), wglb->Quote_illegal, wglb);
} else if (IsPairTerm(t)) {
if (wglb->Ignore_ops) {
wrputs("'.'(", wglb->stream);
lastw = separator;
2018-08-15 01:29:20 +01:00
2018-10-25 18:03:54 +01:00
PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
2018-02-07 21:48:37 +00:00
wrputs(",", wglb->stream);
2019-01-25 08:57:13 +00:00
writeTerm(TailOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt);
2018-02-07 21:48:37 +00:00
wrclose_bracket(wglb, TRUE);
return;
}
if (wglb->Use_portray)
if (callPortray(t, wglb->stream - GLOBAL_Stream PASS_REGS)) {
return;
}
2018-02-07 21:48:37 +00:00
if (trueGlobalPrologFlag(WRITE_STRINGS_FLAG) && IsCodesTerm(t)) {
putString(t, wglb);
} else {
wrputc('[', wglb->stream);
lastw = separator;
/* we assume t was already saved in the stack */
2019-01-28 15:02:55 +00:00
write_list(t, 0, depth, wglb, rwt);
2018-02-07 21:48:37 +00:00
wrputc(']', wglb->stream);
lastw = separator;
}
2018-02-07 21:48:37 +00:00
} else { /* compound term */
Functor functor = FunctorOfTerm(t);
int Arity;
Atom atom;
int op, lp, rp;
if (IsExtensionFunctor(functor)) {
switch ((CELL)functor) {
case (CELL)FunctorDouble:
wrputf(FloatOfTerm(t), wglb);
return;
case (CELL)FunctorString:
write_string(UStringOfTerm(t), wglb);
return;
case (CELL)FunctorAttVar:
2018-06-01 13:22:13 +01:00
write_var(RepAppl(t) + 1, wglb, &nrwt);
2018-02-07 21:48:37 +00:00
return;
case (CELL)FunctorDBRef:
wrputref(RefOfTerm(t), wglb->Quote_illegal, wglb);
return;
case (CELL)FunctorLongInt:
wrputn(LongIntOfTerm(t), wglb);
return;
/* case (CELL)FunctorBigInt: */
default:
2018-06-01 13:22:13 +01:00
writebig(t, p, depth, rinfixarg, wglb, rwt);
2018-02-07 21:48:37 +00:00
return;
}
2017-09-23 02:17:55 +01:00
}
2018-02-07 21:48:37 +00:00
Arity = ArityOfFunctor(functor);
atom = NameOfFunctor(functor);
#ifdef SFUNC
if (Arity == SFArity) {
int argno = 1;
CELL *p = ArgsOfSFTerm(t);
putAtom(atom, wglb->Quote_illegal, wglb);
wropen_bracket(wglb, FALSE);
lastw = separator;
while (*p) {
Int sl = 0;
while (argno < *p) {
wrputc('_', wglb->stream), wrputc(',', wglb->stream);
++argno;
}
*p++;
lastw = separator;
/* cannot use the term directly with the SBA */
2019-01-28 15:02:55 +00:00
PROTECT(t, writeTerm(*p, 999, depth + 1, FALSE, wglb, &nrwt));
2018-02-07 21:48:37 +00:00
if (*p)
wrputc(',', wglb->stream);
argno++;
}
wrclose_bracket(wglb, TRUE);
2017-09-23 02:17:55 +01:00
return;
}
2018-02-07 21:48:37 +00:00
#endif
if (wglb->Use_portray) {
if (callPortray(t, wglb->stream - GLOBAL_Stream PASS_REGS)) {
return;
}
}
if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
Term tright = ArgOfTerm(1, t);
2018-08-15 01:29:20 +01:00
int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
2018-02-07 21:48:37 +00:00
Yap_IsOp(AtomOfTerm(tright));
if (op > p) {
wropen_bracket(wglb, TRUE);
}
putAtom(atom, wglb->Quote_illegal, wglb);
if (bracket_right) {
/* avoid stuff such as \+ (a,b) being written as \+(a,b) */
wropen_bracket(wglb, TRUE);
} else if (atom == AtomMinus) {
last_minus = TRUE;
}
2019-01-25 08:57:13 +00:00
writeTerm(tright, rp, depth + 1, TRUE, wglb, &nrwt);
2018-06-01 13:22:13 +01:00
if (bracket_right) {
2018-02-07 21:48:37 +00:00
wrclose_bracket(wglb, TRUE);
}
if (op > p) {
wrclose_bracket(wglb, TRUE);
}
2018-02-07 21:48:37 +00:00
} else if (!wglb->Ignore_ops &&
(Arity == 1 ||
((atom == AtomEmptyBrackets || atom == AtomCurly ||
atom == AtomEmptySquareBrackets) &&
Yap_IsListTerm(ArgOfTerm(1, t)))) &&
Yap_IsPosfixOp(atom, &op, &lp)) {
Term tleft = ArgOfTerm(1, t);
2018-08-15 01:29:20 +01:00
int bracket_left, offset;
2018-02-07 21:48:37 +00:00
if (Arity != 1) {
tleft = ArgOfTerm(1, t);
2018-08-15 01:29:20 +01:00
offset = 2;
2013-07-07 22:15:25 +01:00
} else {
2018-02-07 21:48:37 +00:00
tleft = ArgOfTerm(1, t);
2018-08-15 01:29:20 +01:00
offset = 1;
2013-07-07 22:15:25 +01:00
}
2018-02-07 21:48:37 +00:00
bracket_left =
!IsVarTerm(tleft) && IsAtomTerm(tleft) && Yap_IsOp(AtomOfTerm(tleft));
if (op > p) {
/* avoid stuff such as \+ (a,b) being written as \+(a,b) */
wropen_bracket(wglb, TRUE);
}
2018-02-07 21:48:37 +00:00
if (bracket_left) {
wropen_bracket(wglb, TRUE);
}
2019-01-25 08:57:13 +00:00
writeTerm(ArgOfTerm(offset, t), lp, depth + 1, rinfixarg, wglb, &nrwt);
2018-02-07 21:48:37 +00:00
if (bracket_left) {
wrclose_bracket(wglb, TRUE);
}
2018-02-07 21:48:37 +00:00
if (Arity > 1) {
if (atom == AtomEmptyBrackets) {
wrputc('(', wglb->stream);
} else if (atom == AtomEmptySquareBrackets) {
wrputc('[', wglb->stream);
} else if (atom == AtomCurly) {
wrputc('{', wglb->stream);
}
lastw = separator;
2018-06-01 13:22:13 +01:00
write_list(tleft, 0, depth, wglb, rwt);
2018-02-07 21:48:37 +00:00
if (atom == AtomEmptyBrackets) {
wrputc(')', wglb->stream);
} else if (atom == AtomEmptySquareBrackets) {
wrputc(']', wglb->stream);
} else if (atom == AtomCurly) {
wrputc('}', wglb->stream);
}
lastw = separator;
} else {
2018-02-07 21:48:37 +00:00
putAtom(atom, wglb->Quote_illegal, wglb);
2014-05-15 01:11:26 +01:00
}
2018-02-07 21:48:37 +00:00
if (op > p) {
wrclose_bracket(wglb, TRUE);
}
} else if (!wglb->Ignore_ops && Arity == 2 &&
Yap_IsInfixOp(atom, &op, &lp, &rp)) {
Term tleft = ArgOfTerm(1, t);
Term tright = ArgOfTerm(2, t);
int bracket_left =
!IsVarTerm(tleft) && IsAtomTerm(tleft) && Yap_IsOp(AtomOfTerm(tleft));
int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
Yap_IsOp(AtomOfTerm(tright));
if (op > p) {
/* avoid stuff such as \+ (a,b) being written as \+(a,b) */
wropen_bracket(wglb, TRUE);
lastw = separator;
}
if (bracket_left) {
wropen_bracket(wglb, TRUE);
}
2018-10-25 18:03:54 +01:00
PROTECT(
t, writeTerm(ArgOfTerm(1, t), lp, depth + 1, rinfixarg, wglb, &nrwt));
2018-02-07 21:48:37 +00:00
if (bracket_left) {
wrclose_bracket(wglb, TRUE);
}
/* avoid quoting commas and bars */
if (!strcmp((char *)RepAtom(atom)->StrOfAE, ",")) {
wrputc(',', wglb->stream);
lastw = separator;
} else if (!strcmp((char *)RepAtom(atom)->StrOfAE, "|")) {
if (lastw == symbol || lastw == separator) {
wrputc(' ', wglb->stream);
}
wrputc('|', wglb->stream);
lastw = separator;
} else
putAtom(atom, wglb->Quote_illegal, wglb);
if (bracket_right) {
wropen_bracket(wglb, TRUE);
}
2019-01-25 08:57:13 +00:00
writeTerm(ArgOfTerm(2, t), rp, depth + 1, TRUE, wglb, &nrwt);
2018-02-07 21:48:37 +00:00
if (bracket_right) {
wrclose_bracket(wglb, TRUE);
}
if (op > p) {
wrclose_bracket(wglb, TRUE);
}
} else if (functor == FunctorDollarVar) {
Term ti = ArgOfTerm(1, t);
if (lastw == alphanum) {
wrputc(' ', wglb->stream);
}
if (wglb->Handle_vars && !IsVarTerm(ti) &&
(IsIntTerm(ti) || IsCodesTerm(ti) || IsAtomTerm(ti) ||
IsStringTerm(ti))) {
if (IsIntTerm(ti)) {
Int k = IntOfTerm(ti);
if (k == -1) {
wrputc('_', wglb->stream);
lastw = alphanum;
return;
} else {
wrputc((k % 26) + 'A', wglb->stream);
if (k >= 26) {
/* make sure we don't get confused about our context */
lastw = separator;
wrputn(k / 26, wglb);
} else
lastw = alphanum;
}
} else if (IsAtomTerm(ti)) {
putAtom(AtomOfTerm(ti), FALSE, wglb);
} else if (IsStringTerm(ti)) {
putString(ti, wglb);
} else {
putUnquotedString(ti, wglb);
}
2017-09-23 02:17:55 +01:00
} else {
2018-02-07 21:48:37 +00:00
wrputs("'$VAR'(", wglb->stream);
lastw = separator;
2019-01-25 08:57:13 +00:00
writeTerm(ArgOfTerm(1, t), 999, depth + 1, FALSE, wglb, &nrwt);
2018-02-07 21:48:37 +00:00
wrclose_bracket(wglb, TRUE);
2017-09-23 02:17:55 +01:00
}
2018-02-07 21:48:37 +00:00
} else if (!wglb->Ignore_ops && functor == FunctorBraces) {
wrputc('{', wglb->stream);
lastw = separator;
2019-01-25 08:57:13 +00:00
writeTerm(ArgOfTerm(1, t), GLOBAL_MaxPriority, depth + 1, FALSE, wglb,
&nrwt);
2018-02-07 21:48:37 +00:00
wrputc('}', wglb->stream);
lastw = separator;
} else if (atom == AtomArray) {
wrputc('{', wglb->stream);
lastw = separator;
for (op = 1; op <= Arity; ++op) {
if (op == wglb->MaxArgs) {
wrputs("...", wglb->stream);
break;
}
2019-01-25 08:57:13 +00:00
writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt);
2018-02-07 21:48:37 +00:00
if (op != Arity) {
2018-10-25 18:03:54 +01:00
PROTECT(t, writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb,
&nrwt));
2018-02-07 21:48:37 +00:00
wrputc(',', wglb->stream);
lastw = separator;
}
}
2019-01-25 08:57:13 +00:00
writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt);
2018-02-07 21:48:37 +00:00
wrputc('}', wglb->stream);
lastw = separator;
2019-04-04 13:27:06 +01:00
} else {
if (!wglb->Ignore_ops && atom == AtomHeap) {
Arity = 3+2*IntegerOfTerm(ArgOfTerm(1,t));
}
2018-02-07 21:48:37 +00:00
putAtom(atom, wglb->Quote_illegal, wglb);
lastw = separator;
wropen_bracket(wglb, FALSE);
2018-08-15 01:29:20 +01:00
for (op = 1; op < Arity; ++op) {
2018-02-07 21:48:37 +00:00
if (op == wglb->MaxArgs) {
wrputc('.', wglb->stream);
wrputc('.', wglb->stream);
wrputc('.', wglb->stream);
break;
}
2018-10-25 18:03:54 +01:00
PROTECT(
t, writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt));
wrputc(',', wglb->stream);
lastw = separator;
2017-09-23 02:17:55 +01:00
}
2019-01-25 08:57:13 +00:00
writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt);
2018-02-07 21:48:37 +00:00
wrclose_bracket(wglb, TRUE);
2015-06-19 01:30:13 +01:00
}
}
2018-02-07 21:48:37 +00:00
}
2015-09-21 23:05:36 +01:00
2018-02-07 21:48:37 +00:00
void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
int priority)
/* term to be written */
/* consumer */
/* write options */
{
CACHE_REGS
2019-02-03 21:35:12 +00:00
yhandle_t lvl = push_text_stack();
2018-02-07 21:48:37 +00:00
struct write_globs wglb;
2018-08-15 01:29:20 +01:00
struct rewind_term rwt;
2019-02-04 10:42:23 +00:00
t = Deref(t);
2018-08-15 01:29:20 +01:00
rwt.parent = NULL;
2019-02-03 21:35:12 +00:00
wglb.stream = mywrite;
2018-02-07 21:48:37 +00:00
wglb.Ignore_ops = flags & Ignore_ops_f;
wglb.Write_strings = flags & BackQuote_String_f;
2019-02-15 13:50:24 +00:00
wglb.Use_portray = flags & Use_portray_f;
wglb.Handle_vars = flags & Handle_vars_f;
wglb.Portray_delays = flags & AttVar_Portray_f;
wglb.Keep_terms = flags & To_heap_f;
wglb.Write_Loops = flags & Handle_cyclics_f;
wglb.Quote_illegal = flags & Quote_illegal_f;
2019-02-09 09:43:26 +00:00
wglb.MaxArgs = 0 ;
2019-02-15 21:09:58 +00:00
wglb.MaxDepth = 0 ;
2019-02-06 00:08:15 +00:00
wglb.lw = separator;
2019-02-11 18:10:31 +00:00
Term tp;
2019-02-09 09:43:26 +00:00
if ((flags & Handle_cyclics_f) ){
2019-02-11 18:10:31 +00:00
tp = Yap_CyclesInTerm(t PASS_REGS);
} else {
tp = t;
2019-02-03 21:35:12 +00:00
}
2019-02-09 09:43:26 +00:00
/* protect slots for portray */
2019-02-11 18:10:31 +00:00
writeTerm(tp, priority, 1, false, &wglb, &rwt);
2019-02-17 23:19:26 +00:00
if (flags & New_Line_f) {
2018-02-07 21:48:37 +00:00
if (flags & Fullstop_f) {
wrputc('.', wglb.stream);
wrputc('\n', wglb.stream);
} else {
wrputc('\n', wglb.stream);
}
} else {
if (flags & Fullstop_f) {
wrputc('.', wglb.stream);
wrputc(' ', wglb.stream);
}
2017-09-23 02:17:55 +01:00
}
2018-05-15 12:36:18 +01:00
pop_text_stack(lvl);
2019-02-03 21:35:12 +00:00
}
2019-02-10 00:18:08 +00:00