1224 lines
31 KiB
C
1224 lines
31 KiB
C
/*************************************************************************
|
|
* *
|
|
* YAP Prolog *
|
|
* *
|
|
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
|
* *
|
|
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
|
* *
|
|
**************************************************************************
|
|
* *
|
|
* File: write.c * Last
|
|
*rev: * mods:
|
|
** comments: Writing a Prolog Term *
|
|
* *
|
|
*************************************************************************/
|
|
#ifdef SCCS
|
|
static char SccsId[] = "%W% %G%";
|
|
#endif
|
|
|
|
#include "Yap.h"
|
|
#include "YapHeap.h"
|
|
#include "YapText.h"
|
|
#include "Yatom.h"
|
|
#include "clause.h"
|
|
#include "yapio.h"
|
|
#include <math.h>
|
|
#include <stdlib.h>
|
|
#if COROUTINING
|
|
#include "attvar.h"
|
|
#endif
|
|
#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 {
|
|
start, /* initialization */
|
|
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;
|
|
|
|
typedef StreamDesc *wrf;
|
|
|
|
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 {
|
|
StreamDesc *stream;
|
|
bool Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays;
|
|
bool Keep_terms;
|
|
bool Write_Loops;
|
|
bool Write_strings;
|
|
UInt last_atom_minus;
|
|
UInt MaxDepth, MaxArgs;
|
|
wtype lw;
|
|
CELL *visited, *visited0, *visited_top;
|
|
} wglbs;
|
|
|
|
#define lastw wglb->lw
|
|
#define last_minus wglb->last_atom_minus
|
|
|
|
static bool callPortray(Term t, int sno USES_REGS) {
|
|
PredEntry *pe;
|
|
Int b0 = LCL0 - (CELL *)B;
|
|
|
|
UNLOCK(GLOBAL_Stream[sno].streamlock);
|
|
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);
|
|
LOCK(GLOBAL_Stream[sno].streamlock);
|
|
return true;
|
|
}
|
|
LOCK(GLOBAL_Stream[sno].streamlock);
|
|
|
|
return false;
|
|
}
|
|
|
|
#define PROTECT(t, F) \
|
|
{ \
|
|
yhandle_t yt = Yap_InitHandle(t); \
|
|
F; \
|
|
t = Yap_PopHandle(yt); \
|
|
}
|
|
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 *);
|
|
static void writeTerm(Term, int, int, int, struct write_globs *,
|
|
struct rewind_term *);
|
|
|
|
#define wrputc(WF, X) \
|
|
(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
|
|
*/
|
|
static void wropen_bracket(struct write_globs *wglb, int protect) {
|
|
StreamDesc *stream = wglb->stream;
|
|
|
|
if (lastw != separator && protect)
|
|
wrputc(' ', stream);
|
|
wrputc('(', stream);
|
|
lastw = separator;
|
|
}
|
|
|
|
static void wrclose_bracket(struct write_globs *wglb, int protect) {
|
|
wrf stream = wglb->stream;
|
|
|
|
wrputc(')', stream);
|
|
lastw = separator;
|
|
}
|
|
|
|
static int protect_open_number(struct write_globs *wglb, int lm,
|
|
int minus_required) {
|
|
wrf stream = wglb->stream;
|
|
|
|
if (lastw == symbol && lm && !minus_required) {
|
|
wropen_bracket(wglb, TRUE);
|
|
return TRUE;
|
|
} else if (lastw == alphanum || (lastw == symbol && minus_required)) {
|
|
wrputc(' ', stream);
|
|
}
|
|
return FALSE;
|
|
}
|
|
|
|
static void protect_close_number(struct write_globs *wglb, int used_bracket) {
|
|
if (used_bracket) {
|
|
wrclose_bracket(wglb, TRUE);
|
|
} else {
|
|
lastw = alphanum;
|
|
}
|
|
last_minus = FALSE;
|
|
}
|
|
|
|
static void wrputn(Int n,
|
|
struct write_globs *wglb) /* writes an integer */
|
|
{
|
|
wrf stream = wglb->stream;
|
|
char s[256], *s1 = s; /* that should be enough for most integers */
|
|
int has_minus = (n < 0);
|
|
int ob;
|
|
|
|
ob = protect_open_number(wglb, last_minus, has_minus);
|
|
#if HAVE_SNPRINTF
|
|
snprintf(s, 256, Int_FORMAT, n);
|
|
#else
|
|
sprintf(s, Int_FORMAT, n);
|
|
#endif
|
|
while (*s1)
|
|
wrputc(*s1++, stream);
|
|
protect_close_number(wglb, ob);
|
|
}
|
|
|
|
inline static void wrputs(char *s, StreamDesc *stream) {
|
|
int c;
|
|
while ((c = *s++))
|
|
wrputc(c, stream);
|
|
}
|
|
|
|
#ifdef USE_GMP
|
|
|
|
static char *ensure_space(size_t sz) {
|
|
CACHE_REGS
|
|
char *s;
|
|
|
|
s = (char *)Yap_PreAllocCodeSpace();
|
|
while (s + sz >= (char *)AuxSp) {
|
|
#if USE_SYSTEM_MALLOC
|
|
/* may require stack expansion */
|
|
if (!Yap_ExpandPreAllocCodeSpace(sz, NULL, TRUE)) {
|
|
s = NULL;
|
|
break;
|
|
}
|
|
s = (char *)Yap_PreAllocCodeSpace();
|
|
#else
|
|
s = NULL;
|
|
#endif
|
|
}
|
|
if (!s) {
|
|
s = (char *)TR;
|
|
while (s + sz >= LOCAL_TrailTop) {
|
|
if (!Yap_growtrail(sz / sizeof(CELL), FALSE)) {
|
|
s = NULL;
|
|
break;
|
|
}
|
|
s = (char *)TR;
|
|
}
|
|
}
|
|
if (!s) {
|
|
s = (char *)HR;
|
|
if (s + sz >= (char *)ASP) {
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil,
|
|
"not enough space to write bignum: it requires %d bytes", sz);
|
|
s = NULL;
|
|
}
|
|
}
|
|
return s;
|
|
}
|
|
|
|
static void write_mpint(MP_INT *big, struct write_globs *wglb) {
|
|
char *s;
|
|
int has_minus = mpz_sgn(big);
|
|
int ob;
|
|
|
|
s = ensure_space(3 + mpz_sizeinbase(big, 10));
|
|
ob = protect_open_number(wglb, last_minus, has_minus);
|
|
if (!s) {
|
|
s = mpz_get_str(NULL, 10, big);
|
|
if (!s)
|
|
return;
|
|
wrputs(s, wglb->stream);
|
|
free(s);
|
|
} else {
|
|
mpz_get_str(s, 10, big);
|
|
wrputs(s, wglb->stream);
|
|
}
|
|
protect_close_number(wglb, ob);
|
|
}
|
|
#endif
|
|
|
|
/* writes a bignum */
|
|
static void writebig(Term t, int p, int depth, int rinfixarg,
|
|
struct write_globs *wglb, struct rewind_term *rwt) {
|
|
CELL *pt = RepAppl(t) + 1;
|
|
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
|
|
} else if (big_tag == BIG_INT) {
|
|
MP_INT *big = Yap_BigIntOfTerm(t);
|
|
write_mpint(big, wglb);
|
|
return;
|
|
} else if (big_tag == BIG_RATIONAL) {
|
|
Term trat = Yap_RatTermToApplTerm(t);
|
|
writeTerm(trat, p, depth, rinfixarg, wglb, rwt);
|
|
return;
|
|
#endif
|
|
} else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) {
|
|
YAP_Opaque_CallOnWrite f;
|
|
CELL blob_info;
|
|
|
|
blob_info = big_tag;
|
|
if (GLOBAL_OpaqueHandlers &&
|
|
(f = GLOBAL_OpaqueHandlers[blob_info].write_handler)) {
|
|
(f)(wglb->stream->file, big_tag, ExternalBlobFromTerm(t), 0);
|
|
return;
|
|
}
|
|
}
|
|
wrputs("0", wglb->stream);
|
|
}
|
|
|
|
static void wrputf(Float f, struct write_globs *wglb) /* writes a float */
|
|
|
|
{
|
|
#if THREADS
|
|
char s[256];
|
|
#endif
|
|
wrf stream = wglb->stream;
|
|
int sgn;
|
|
int ob;
|
|
|
|
#if HAVE_ISNAN || defined(__WIN32)
|
|
if (isnan(f)) {
|
|
wrputs("(nan)", stream);
|
|
lastw = separator;
|
|
return;
|
|
}
|
|
#endif
|
|
sgn = (f < 0.0);
|
|
#if HAVE_ISINF || defined(_WIN32)
|
|
if (isinf(f)) {
|
|
if (sgn) {
|
|
wrputs("(-inf)", stream);
|
|
} else {
|
|
wrputs("(+inf)", stream);
|
|
}
|
|
lastw = separator;
|
|
return;
|
|
}
|
|
#endif
|
|
ob = protect_open_number(wglb, last_minus, sgn);
|
|
#if THREADS
|
|
/* old style writing */
|
|
int found_dot = FALSE;
|
|
char *pt = s;
|
|
int ch;
|
|
/* always use C locale for writing numbers */
|
|
#if O_LOCALE
|
|
const unsigned char *decimalpoint =
|
|
(unsigned char *)localeconv()->decimal_point;
|
|
size_t l1 = strlen((const char *)decimalpoint + 1);
|
|
#else
|
|
const unsigned char decimalpoint[2] = ".";
|
|
size_t l1 = 0;
|
|
#endif
|
|
|
|
if (lastw == symbol || lastw == alphanum) {
|
|
wrputc(' ', stream);
|
|
}
|
|
lastw = alphanum;
|
|
// sprintf(s, "%.15g", f);
|
|
sprintf(s, floatFormat(), f);
|
|
while (*pt == ' ')
|
|
pt++;
|
|
if (*pt == '-') {
|
|
wrputc('-', stream);
|
|
pt++;
|
|
}
|
|
while ((ch = *pt) != '\0') {
|
|
// skip locale
|
|
if (ch == decimalpoint[0] &&
|
|
!strncmp(pt + 1, (char *)decimalpoint + 1, l1)) {
|
|
found_dot = TRUE;
|
|
pt += l1;
|
|
ch = '.';
|
|
}
|
|
if (ch == 'e' || ch == 'E') {
|
|
if (!found_dot) {
|
|
found_dot = TRUE;
|
|
wrputs(".0", stream);
|
|
}
|
|
found_dot = true;
|
|
}
|
|
wrputc(ch, stream);
|
|
pt++;
|
|
}
|
|
if (!found_dot) {
|
|
wrputs(".0", stream);
|
|
}
|
|
#else
|
|
char buf[256];
|
|
|
|
if (lastw == symbol || lastw == alphanum) {
|
|
wrputc(' ', stream);
|
|
}
|
|
/* use SWI's format_float */
|
|
sprintf(buf, (char *)floatFormat(), f);
|
|
|
|
wrputs(buf, stream);
|
|
#endif
|
|
protect_close_number(wglb, ob);
|
|
}
|
|
|
|
int Yap_FormatFloat(Float f, char **s, size_t sz) {
|
|
CACHE_REGS
|
|
struct write_globs wglb;
|
|
int sno;
|
|
|
|
sno = Yap_open_buf_write_stream(GLOBAL_Stream[LOCAL_c_output_stream].encoding,
|
|
0);
|
|
if (sno < 0)
|
|
return false;
|
|
wglb.lw = separator;
|
|
wglb.stream = GLOBAL_Stream + sno;
|
|
wrputf(f, &wglb);
|
|
*s = Yap_MemExportStreamPtr(sno);
|
|
Yap_CloseStream(sno);
|
|
return true;
|
|
}
|
|
|
|
/* writes a data base reference */
|
|
static void wrputref(CODEADDR ref, int Quote_illegal,
|
|
struct write_globs *wglb) {
|
|
char s[256];
|
|
wrf stream = wglb->stream;
|
|
|
|
putAtom(AtomDBref, Quote_illegal, wglb);
|
|
#if defined(__linux__) || defined(__APPLE__)
|
|
sprintf(s, "(%p," UInt_FORMAT ")", ref, ((LogUpdClause *)ref)->ClRefCount);
|
|
#else
|
|
sprintf(s, "(0x%p," UInt_FORMAT ")", ref, ((LogUpdClause *)ref)->ClRefCount);
|
|
#endif
|
|
wrputs(s, stream);
|
|
lastw = alphanum;
|
|
}
|
|
|
|
static inline bool was_visited(Term t, wglbs *wg, Term *ta) {
|
|
Term *tp;
|
|
if (IsApplTerm(t)) {
|
|
tp = RepAppl(t);
|
|
*ta = tp[0];
|
|
return false;
|
|
if (IsExtensionFunctor(FunctorOfTerm(t))) {
|
|
return false;
|
|
}
|
|
} else if (IsPairTerm(t)) {
|
|
tp = RepPair(t);
|
|
*ta = tp[0];
|
|
return false;
|
|
} else
|
|
return false;
|
|
if (IsAtomTerm(*tp)) {
|
|
CELL *pt = (CELL *)AtomOfTerm(*tp);
|
|
if (pt >= wg->visited0 && pt < wg->visited) {
|
|
int depth = (wg->visited) - pt;
|
|
wrputs(" @[-", wg->stream);
|
|
wrputn(depth, wg);
|
|
wrputs("] ", wg->stream);
|
|
return true;
|
|
}
|
|
}
|
|
wg->visited[0] = *tp;
|
|
*tp = MkAtomTerm((Atom)wg->visited);
|
|
wg->visited++;
|
|
|
|
return false;
|
|
}
|
|
|
|
static inline Term visited_indirection(Term t, wglbs *wg) {
|
|
Term *tp = (CELL *)AtomOfTerm(t);
|
|
if (tp >= wg->visited0 && (CELL *)tp < wg->visited_top)
|
|
return *tp;
|
|
return 0;
|
|
}
|
|
|
|
static inline void done_visiting(Term t, wglbs *wg) {
|
|
Term *tp;
|
|
return;
|
|
if (IsApplTerm(t))
|
|
tp = RepAppl(t);
|
|
else if (IsPairTerm(t))
|
|
tp = RepPair(t);
|
|
else
|
|
return;
|
|
*tp = *--wg->visited;
|
|
}
|
|
|
|
/* 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);
|
|
|
|
if ((rc = Yap_write_blob(ref, stream))) {
|
|
return rc;
|
|
}
|
|
lastw = alphanum;
|
|
return 1;
|
|
}
|
|
|
|
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;
|
|
}
|
|
while (ch) {
|
|
if (Yap_chtype[ch] != SY) {
|
|
return false;
|
|
}
|
|
ch = *++s;
|
|
}
|
|
}
|
|
return true;
|
|
} else
|
|
while ((ch = *++s) != 0)
|
|
if (Yap_chtype[ch] > NU)
|
|
return false;
|
|
return true;
|
|
}
|
|
|
|
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;
|
|
}
|
|
return symbol;
|
|
}
|
|
|
|
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;
|
|
}
|
|
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);
|
|
wrputc(ch, stream);
|
|
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];
|
|
|
|
/* last backslash in ISO mode */
|
|
sprintf(esc, "\\%03o\\", ch);
|
|
wrputs(esc, stream);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
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);
|
|
}
|
|
|
|
/* 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;
|
|
if (atom == NULL)
|
|
return;
|
|
s = RepAtom(atom)->UStrOfAE;
|
|
if (s[0] == '\0') {
|
|
if (Quote_illegal) {
|
|
wrputc('\'', stream);
|
|
wrputc('\'', stream);
|
|
}
|
|
return;
|
|
}
|
|
if (IsBlob(atom)) {
|
|
wrputblob(RepAtom(atom), Quote_illegal, wglb);
|
|
return;
|
|
}
|
|
/* #define CRYPT_FOR_STEVE 1*/
|
|
#ifdef CRYPT_FOR_STEVE
|
|
if (Yap_GetValue(AtomCryptAtoms) != TermNil &&
|
|
Yap_GetAProp(atom, OpProperty) == NIL) {
|
|
char s[16];
|
|
sprintf(s, "x%x", (CELL)s);
|
|
wrputs(s, stream);
|
|
return;
|
|
}
|
|
#endif
|
|
/* 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);
|
|
}
|
|
wrputc('\'', stream);
|
|
} else {
|
|
wrputs((char *)s, stream);
|
|
}
|
|
}
|
|
|
|
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;
|
|
|
|
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);
|
|
if (IsVarTerm(string))
|
|
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);
|
|
}
|
|
wrputc('"', stream);
|
|
lastw = alphanum;
|
|
}
|
|
|
|
/* writes a string */
|
|
static void putUnquotedString(Term string, struct write_globs *wglb)
|
|
|
|
{
|
|
wrf stream = wglb->stream;
|
|
while (string != TermNil) {
|
|
int ch = IntOfTerm(HeadOfTerm(string));
|
|
wrputc(ch, stream);
|
|
string = TailOfTerm(string);
|
|
}
|
|
lastw = alphanum;
|
|
}
|
|
|
|
static void write_var(CELL *t, struct write_globs *wglb,
|
|
struct rewind_term *rwt) {
|
|
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);
|
|
struct rewind_term nrwt;
|
|
nrwt.parent = rwt;
|
|
nrwt.u_sd.s.ptr = 0;
|
|
|
|
wglb->Portray_delays = FALSE;
|
|
if (ext == attvars_ext) {
|
|
attvar_record *attv = RepAttVar(t);
|
|
CELL *l = &attv->Value; /* dirty low-level hack, check atts.h */
|
|
|
|
wrputs("$AT(", wglb->stream);
|
|
write_var(t, wglb, rwt);
|
|
wrputc(',', wglb->stream);
|
|
PROTECT(*t, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt));
|
|
attv = RepAttVar(t);
|
|
wrputc(',', wglb->stream);
|
|
l++;
|
|
writeTerm(*l, 999, 1, FALSE, wglb, &nrwt);
|
|
wrclose_bracket(wglb, TRUE);
|
|
}
|
|
wglb->Portray_delays = TRUE;
|
|
return;
|
|
}
|
|
wrputc('D', wglb->stream);
|
|
wrputn(vcount, wglb);
|
|
} else {
|
|
wrputn(((Int)(t - H0)), wglb);
|
|
}
|
|
}
|
|
|
|
static void write_list(Term t, Term hot, int direction, int depth,
|
|
struct write_globs *wglb, struct rewind_term *rwt) {
|
|
Term ti;
|
|
struct rewind_term nrwt;
|
|
nrwt.parent = rwt;
|
|
nrwt.u_sd.s.ptr = 0;
|
|
while (true) {
|
|
PROTECT(t, writeTerm(hot, 999, depth + 1, FALSE, wglb, &nrwt));
|
|
ti = TailOfTerm(t);
|
|
if (IsVarTerm(ti))
|
|
break;
|
|
if (!IsPairTerm(ti))
|
|
break;
|
|
if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) {
|
|
if (lastw == symbol || lastw == separator) {
|
|
wrputc(' ', wglb->stream);
|
|
}
|
|
wrputc('|', wglb->stream);
|
|
putAtom(Atom3Dots, wglb->Quote_illegal, wglb);
|
|
done_visiting(t, wglb);
|
|
return;
|
|
}
|
|
lastw = separator;
|
|
depth++;
|
|
wrputc(',', wglb->stream);
|
|
if ((was_visited(ti, wglb, &hot))) {
|
|
break;
|
|
}
|
|
write_list(ti, hot, direction, depth, wglb, &nrwt);
|
|
done_visiting(ti, wglb);
|
|
return;
|
|
}
|
|
if (IsPairTerm(ti)) {
|
|
/* we found an infinite loop */
|
|
/* keep going on the list */
|
|
wrputc(',', wglb->stream);
|
|
write_list(ti, hot, direction, depth, wglb, &nrwt);
|
|
done_visiting(ti, wglb);
|
|
} else if (ti != TermNil) {
|
|
if (lastw == symbol || lastw == separator) {
|
|
wrputc(' ', wglb->stream);
|
|
}
|
|
wrputc('|', wglb->stream);
|
|
lastw = separator;
|
|
writeTerm(ti, 999, depth, FALSE, wglb, &nrwt);
|
|
done_visiting(ti, wglb);
|
|
}
|
|
}
|
|
|
|
static void writeTerm(Term t, int p, int depth, int rinfixarg,
|
|
struct write_globs *wglb, struct rewind_term *rwt)
|
|
/* term to write */
|
|
/* context priority */
|
|
{
|
|
CACHE_REGS
|
|
struct rewind_term nrwt;
|
|
nrwt.parent = rwt;
|
|
nrwt.u_sd.s.ptr = 0;
|
|
|
|
if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) {
|
|
putAtom(Atom3Dots, wglb->Quote_illegal, wglb);
|
|
return;
|
|
}
|
|
t = Deref(t);
|
|
if (IsVarTerm(t)) {
|
|
write_var((CELL *)t, wglb, &nrwt);
|
|
} else if (IsIntTerm(t)) {
|
|
wrputn((Int)IntOfTerm(t), wglb);
|
|
} else if (IsAtomTerm(t)) {
|
|
Term tn;
|
|
if ((tn = visited_indirection(t, wglb)) != 0) {
|
|
writeTerm(tn, p, depth, rinfixarg, wglb, rwt);
|
|
return;
|
|
}
|
|
putAtom(AtomOfTerm(t), wglb->Quote_illegal, wglb);
|
|
} else if (IsPairTerm(t)) {
|
|
Term hot;
|
|
if ((was_visited(t, wglb, &hot))) {
|
|
return;
|
|
}
|
|
if (wglb->Ignore_ops) {
|
|
wrputs("'.'(", wglb->stream);
|
|
lastw = separator;
|
|
|
|
PROTECT(t, writeTerm(hot, 999, depth + 1, FALSE, wglb, &nrwt));
|
|
wrputs(",", wglb->stream);
|
|
writeTerm(TailOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt);
|
|
done_visiting(t, wglb);
|
|
wrclose_bracket(wglb, TRUE);
|
|
return;
|
|
}
|
|
if (wglb->Use_portray) {
|
|
done_visiting(t, wglb);
|
|
if (callPortray(t, wglb->stream - GLOBAL_Stream PASS_REGS)) {
|
|
return;
|
|
}
|
|
if ((was_visited(t, wglb, &hot))) {
|
|
return;
|
|
}
|
|
|
|
}
|
|
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 */
|
|
write_list(t, hot, 0, depth, wglb, rwt);
|
|
done_visiting(t, wglb);
|
|
wrputc(']', wglb->stream);
|
|
lastw = separator;
|
|
}
|
|
} else { /* compound term */
|
|
Functor functor;
|
|
int Arity;
|
|
Atom atom;
|
|
int op, lp, rp;
|
|
|
|
Term argf;
|
|
if (was_visited(t, wglb, &argf)) {
|
|
return;
|
|
}
|
|
functor = (Functor)argf;
|
|
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:
|
|
write_var(RepAppl(t) + 1, wglb, &nrwt);
|
|
return;
|
|
case (CELL)FunctorDBRef:
|
|
wrputref(RefOfTerm(t), wglb->Quote_illegal, wglb);
|
|
return;
|
|
case (CELL)FunctorLongInt:
|
|
wrputn(LongIntOfTerm(t), wglb);
|
|
return;
|
|
/* case (CELL)FunctorBigInt: */
|
|
default:
|
|
writebig(t, p, depth, rinfixarg, wglb, rwt);
|
|
return;
|
|
}
|
|
}
|
|
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 */
|
|
PROTECT(t, writeTerm(*p, 999, depth + 1, FALSE, wglb, &nrwt));
|
|
if (*p)
|
|
wrputc(',', wglb->stream);
|
|
argno++;
|
|
}
|
|
wrclose_bracket(wglb, TRUE);
|
|
return;
|
|
}
|
|
#endif
|
|
if (wglb->Use_portray) {
|
|
done_visiting(t, wglb);
|
|
if (callPortray(t, wglb->stream - GLOBAL_Stream PASS_REGS)) {
|
|
return;
|
|
}
|
|
Term tf;
|
|
was_visited(t, wglb, &tf);
|
|
functor = (Functor)tf;
|
|
}
|
|
|
|
if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
|
|
Term tright = ArgOfTerm(1, t);
|
|
int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
|
|
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;
|
|
}
|
|
writeTerm(tright, rp, depth + 1, TRUE, wglb, &nrwt);
|
|
if (bracket_right) {
|
|
wrclose_bracket(wglb, TRUE);
|
|
}
|
|
if (op > p) {
|
|
wrclose_bracket(wglb, TRUE);
|
|
}
|
|
} 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);
|
|
|
|
int bracket_left, offset;
|
|
|
|
if (Arity != 1) {
|
|
tleft = ArgOfTerm(1, t);
|
|
offset = 2;
|
|
} else {
|
|
tleft = ArgOfTerm(1, t);
|
|
offset = 1;
|
|
}
|
|
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);
|
|
}
|
|
if (bracket_left) {
|
|
wropen_bracket(wglb, TRUE);
|
|
}
|
|
writeTerm(ArgOfTerm(offset, t), lp, depth + 1, rinfixarg, wglb, &nrwt);
|
|
if (bracket_left) {
|
|
wrclose_bracket(wglb, TRUE);
|
|
}
|
|
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;
|
|
writeTerm(tleft, 0, rinfixarg, depth, wglb, rwt);
|
|
if (atom == AtomEmptyBrackets) {
|
|
wrputc(')', wglb->stream);
|
|
} else if (atom == AtomEmptySquareBrackets) {
|
|
wrputc(']', wglb->stream);
|
|
} else if (atom == AtomCurly) {
|
|
wrputc('}', wglb->stream);
|
|
}
|
|
lastw = separator;
|
|
} else {
|
|
putAtom(atom, wglb->Quote_illegal, wglb);
|
|
}
|
|
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);
|
|
}
|
|
PROTECT(
|
|
t, writeTerm(ArgOfTerm(1, t), lp, depth + 1, rinfixarg, wglb, &nrwt));
|
|
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);
|
|
}
|
|
writeTerm(ArgOfTerm(2, t), rp, depth + 1, TRUE, wglb, &nrwt);
|
|
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;
|
|
done_visiting(t, wglb);
|
|
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);
|
|
}
|
|
} else {
|
|
wrputs("'$VAR'(", wglb->stream);
|
|
lastw = separator;
|
|
writeTerm(ArgOfTerm(1, t), 999, depth + 1, FALSE, wglb, &nrwt);
|
|
wrclose_bracket(wglb, TRUE);
|
|
}
|
|
} else if (!wglb->Ignore_ops && functor == FunctorBraces) {
|
|
wrputc('{', wglb->stream);
|
|
lastw = separator;
|
|
writeTerm(ArgOfTerm(1, t), GLOBAL_MaxPriority, depth + 1, FALSE, wglb,
|
|
&nrwt);
|
|
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;
|
|
}
|
|
writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt);
|
|
if (op != Arity) {
|
|
PROTECT(t, writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb,
|
|
&nrwt));
|
|
wrputc(',', wglb->stream);
|
|
lastw = separator;
|
|
}
|
|
}
|
|
writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt);
|
|
wrputc('}', wglb->stream);
|
|
lastw = separator;
|
|
} else {
|
|
if (!wglb->Ignore_ops && atom == AtomHeap) {
|
|
Arity = 3 + 2 * IntegerOfTerm(ArgOfTerm(1, t));
|
|
}
|
|
putAtom(atom, wglb->Quote_illegal, wglb);
|
|
lastw = separator;
|
|
wropen_bracket(wglb, FALSE);
|
|
for (op = 1; op < Arity; ++op) {
|
|
if (op == wglb->MaxArgs) {
|
|
wrputc('.', wglb->stream);
|
|
wrputc('.', wglb->stream);
|
|
wrputc('.', wglb->stream);
|
|
break;
|
|
}
|
|
PROTECT(
|
|
t, writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt));
|
|
wrputc(',', wglb->stream);
|
|
lastw = separator;
|
|
}
|
|
writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt);
|
|
wrclose_bracket(wglb, TRUE);
|
|
}
|
|
done_visiting(t, wglb);
|
|
}
|
|
}
|
|
|
|
void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
|
|
int priority)
|
|
/* term to be written */
|
|
/* consumer */
|
|
/* write options */
|
|
{
|
|
CACHE_REGS
|
|
|
|
yhandle_t lvl = push_text_stack();
|
|
struct write_globs wglb;
|
|
struct rewind_term rwt;
|
|
t = Deref(t);
|
|
rwt.parent = NULL;
|
|
wglb.stream = mywrite;
|
|
wglb.Ignore_ops = flags & Ignore_ops_f;
|
|
wglb.Write_strings = flags & BackQuote_String_f;
|
|
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;
|
|
wglb.MaxArgs = 0;
|
|
wglb.MaxDepth = 0;
|
|
wglb.lw = separator;
|
|
Term tp;
|
|
|
|
if (true && (flags & Handle_cyclics_f)) {
|
|
// tp = Yap_CyclesInTerm(t PASS_REGS);
|
|
wglb.visited = Malloc(1024 * sizeof(CELL)), wglb.visited0 = wglb.visited,
|
|
wglb.visited_top = wglb.visited + 1024;
|
|
}
|
|
tp = t;
|
|
|
|
/* protect slots for portray */
|
|
writeTerm(tp, priority, 1, false, &wglb, &rwt);
|
|
if (flags & New_Line_f) {
|
|
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);
|
|
}
|
|
}
|
|
pop_text_stack(lvl);
|
|
}
|