/*************************************************************************
 *									 *
 *	 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;
  int Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays;
  int Keep_terms;
  int Write_Loops;
  int Write_strings;
  int last_atom_minus;
  UInt MaxDepth, MaxArgs;
  wtype lw;
} wglbs;

#define lastw wglb->lw
#define last_minus wglb->last_atom_minus

static bool callPortray(Term t, struct DB_TERM **old_EXp, int sno USES_REGS) {
  PredEntry *pe;
  Int b0 = LCL0 - (CELL *)B;

  *old_EXp = Yap_RefToException();
  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);
    if (Yap_HasException() && !*old_EXp)
      *old_EXp = Yap_RefToException();
    Yap_fail_all(B0 PASS_REGS);
    LOCK(GLOBAL_Stream[sno].streamlock);
    return true;
  }
  LOCK(GLOBAL_Stream[sno].streamlock);
  if (Yap_HasException() && !*old_EXp)
    *old_EXp = Yap_RefToException();
  return false;
}

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 - USER_BLOB_START;
    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;
  char *so;

  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);
  so = Yap_MemExportStreamPtr(sno);
  *s = BaseMalloc( strlen(so)+1 );
  strcpy(*s, so );
  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;
  }

  /* 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 (IsBlob(atom)) {
      wrputblob(RepAtom(atom), Quote_illegal, wglb);
      return;
    }
    s = RepAtom(atom)->UStrOfAE;
    /* #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 Term from_pointer(CELL *ptr0, struct rewind_term *rwt,
			   struct write_globs *wglb) {
    CACHE_REGS
      Term t;
    CELL *ptr = ptr0;

    while (IsVarTerm(*ptr) && !IsUnboundVar(ptr))
      ptr = (CELL *)*ptr;
    t = *ptr;
    if (wglb->Keep_terms) {
      struct rewind_term *x = rwt->parent;

      rwt->u_sd.s.old = Yap_InitSlot(t);
      rwt->u_sd.s.ptr = Yap_InitSlot((CELL)ptr0);

      if (!IsAtomicTerm(t) && !IsVarTerm(t)) {
	while (x) {
	  if (Yap_GetDerefedFromSlot(x->u_sd.s.old) == t)
	    return TermFoundVar;
	  x = x->parent;
	}
      }
    } else {
      rwt->u_sd.d.old = t;
      rwt->u_sd.d.ptr = ptr0;
      if (!IsVarTerm(t) && !IsAtomicTerm(t)) {
	struct rewind_term *x = rwt->parent;

	while (x) {
	  if (x->u_sd.d.old == t)
	    return TermFoundVar;
	  x = x->parent;
	}
      }
    }
    return t;
  }

  static CELL *restore_from_write(struct rewind_term *rwt,
				  struct write_globs *wglb) {
    CACHE_REGS
      CELL *ptr;

    if (wglb->Keep_terms) {
      ptr = Yap_GetPtrFromSlot(rwt->u_sd.s.ptr);
      Yap_RecoverSlots(2, rwt->u_sd.s.old);
      //      printf("leak=%d %d\n", LOCALCurSlot,rwt->u_sd.s.old) ;
    } else {
      ptr = rwt->u_sd.d.ptr;
    }
    rwt->u_sd.s.ptr = 0;
    return ptr;
  }

  /* writes an unbound variable	 */
  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);
	  writeTerm(from_pointer(l, &nrwt, wglb), 999, 1, FALSE, wglb, &nrwt);
	  l = restore_from_write(&nrwt, wglb);
	  wrputc(',', wglb->stream);
	  l++;
	  writeTerm(from_pointer(l, &nrwt, wglb), 999, 1, FALSE, wglb, &nrwt);
	  restore_from_write(&nrwt, wglb);
	  wrclose_bracket(wglb, TRUE);
	}
	wglb->Portray_delays = TRUE;
	return;
      }
      wrputc('D', wglb->stream);
      wrputn(vcount, wglb);
    } else {
      wrputn(((Int)(t - H0)), wglb);
    }
  }

  static Term check_infinite_loop(Term t, struct rewind_term *x,
				  struct write_globs *wglb) {
    CACHE_REGS
      if (wglb->Keep_terms) {
	while (x) {
	  if (Yap_GetFromSlot(x->u_sd.s.old) == t)
	    return TermFoundVar;
	  x = x->parent;
	}
      } else {
	while (x) {
	  if (x->u_sd.d.old == t)
	    return TermFoundVar;
	  x = x->parent;
	}
      }
    return t;
  }

  static void write_list(Term t, 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 (1) {
      int ndirection;
      int do_jump;

      writeTerm(from_pointer(RepPair(t), &nrwt, wglb), 999, depth + 1, FALSE,
		wglb, &nrwt);
      t = AbsPair(restore_from_write(&nrwt, wglb));
      ti = TailOfTerm(t);
      if (IsVarTerm(ti))
	break;
      if (!IsPairTerm(ti) ||
	  !IsPairTerm((ti = check_infinite_loop(ti, rwt, wglb))))
	break;
      ndirection = RepPair(ti) - RepPair(t);
      /* make sure we're not trapped in loops */
      if (ndirection > 0) {
	do_jump = (direction <= 0);
      } else if (ndirection == 0) {
	wrputc(',', wglb->stream);
	putAtom(AtomFoundVar, wglb->Quote_illegal, wglb);
	lastw = separator;
	return;
      } else {
	do_jump = (direction >= 0);
      }
      if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) {
	if (lastw == symbol || lastw == separator) {
	  wrputc(' ', wglb->stream);
	}
	wrputc('|', wglb->stream);
	putAtom(Atom3Dots, wglb->Quote_illegal, wglb);
	return;
      }
      lastw = separator;
      direction = ndirection;
      depth++;
      if (do_jump)
	break;
      wrputc(',', wglb->stream);
      t = ti;
    }
    if (IsPairTerm(ti)) {
      Term nt = from_pointer(RepPair(t) + 1, &nrwt, wglb);
      /* we found an infinite loop */
      if (IsAtomTerm(nt)) {
	if (lastw == symbol || lastw == separator) {
	  wrputc(' ', wglb->stream);
	}
	wrputc('|', wglb->stream);
	writeTerm(nt, 999, depth, FALSE, wglb, rwt);
      } else {
	/* keep going on the list */
	wrputc(',', wglb->stream);
	write_list(nt, direction, depth, wglb, &nrwt);
      }
      restore_from_write(&nrwt, wglb);
    } else if (ti != MkAtomTerm(AtomNil)) {
      if (lastw == symbol || lastw == separator) {
	wrputc(' ', wglb->stream);
      }
      wrputc('|', wglb->stream);
      lastw = separator;
      writeTerm(from_pointer(RepPair(t) + 1, &nrwt, wglb), 999, depth, FALSE,
		wglb, &nrwt);
      restore_from_write(&nrwt, 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;
    }
    DBTerm *ex;
    Yap_ResetException(worker_id);
    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)) {
      putAtom(AtomOfTerm(t), wglb->Quote_illegal, wglb);
    } else if (IsPairTerm(t)) {
      if (wglb->Ignore_ops) {
	wrputs("'.'(", wglb->stream);
	lastw = separator;

	writeTerm(from_pointer(RepPair(t), &nrwt, wglb), 999, depth + 1, FALSE,
		  wglb, &nrwt);
	t = AbsPair(restore_from_write(&nrwt, wglb));
	wrputs(",", wglb->stream);
	writeTerm(from_pointer(RepPair(t) + 1, &nrwt, wglb), 999, depth + 1,
		  FALSE, wglb, &nrwt);
	restore_from_write(&nrwt, wglb);
	wrclose_bracket(wglb, TRUE);
	return;
      }
      if (wglb->Use_portray)
	if (callPortray(t, &ex, wglb->stream - GLOBAL_Stream PASS_REGS)) {
	  Yap_CopyException(ex);
	  Yap_RaiseException();
	  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, 0, depth, wglb, rwt);
	wrputc(']', wglb->stream);
	lastw = separator;
      }
    } 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:
	  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 */
	  writeTerm(from_pointer(p, &nrwt, wglb), 999, depth + 1, FALSE, wglb,
		    &nrwt);
	  p = restore_from_write(&nrwt, wglb) + 1;
	  if (*p)
	    wrputc(',', wglb->stream);
	  argno++;
	}
	wrclose_bracket(wglb, TRUE);
	return;
      }
#endif
      if (wglb->Use_portray) {
	if (callPortray(t, &ex, wglb->stream - GLOBAL_Stream PASS_REGS)) {
	  Yap_CopyException(ex);
	  Yap_RaiseException();
	  return;
	}
      }
      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(from_pointer(RepAppl(t) + 1, &nrwt, wglb), rp, depth + 1, TRUE,
		  wglb, &nrwt);
	restore_from_write(&nrwt, wglb);
	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(from_pointer(RepAppl(t) + offset, &nrwt, wglb), lp, depth + 1,
		  rinfixarg, wglb, &nrwt);
	restore_from_write(&nrwt, wglb);
	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;
	  write_list(tleft, 0, 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);
	}
	writeTerm(from_pointer(RepAppl(t) + 1, &nrwt, wglb), lp, depth + 1,
		  rinfixarg, wglb, &nrwt);
	t = AbsAppl(restore_from_write(&nrwt, wglb) - 1);
	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(from_pointer(RepAppl(t) + 2, &nrwt, wglb), rp, depth + 1, TRUE,
		  wglb, &nrwt);
	restore_from_write(&nrwt, wglb);
	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);
	  }
	} else {
	  wrputs("'$VAR'(", wglb->stream);
	  lastw = separator;
	  writeTerm(from_pointer(RepAppl(t) + 1, &nrwt, wglb), 999, depth + 1,
		    FALSE, wglb, &nrwt);
	  restore_from_write(&nrwt, wglb);
	  wrclose_bracket(wglb, TRUE);
	}
      } else if (!wglb->Ignore_ops && functor == FunctorBraces) {
	wrputc('{', wglb->stream);
	lastw = separator;
	writeTerm(from_pointer(RepAppl(t) + 1, &nrwt, wglb), GLOBAL_MaxPriority,
		  depth + 1, FALSE, wglb, &nrwt);
	restore_from_write(&nrwt, wglb);
	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(from_pointer(RepAppl(t) + op, &nrwt, wglb), 999, depth + 1,
		    FALSE, wglb, &nrwt);
	  t = AbsAppl(restore_from_write(&nrwt, wglb) - op);
	  if (op != Arity) {
	    wrputc(',', wglb->stream);
	    lastw = separator;
	  }
	}
	wrputc('}', wglb->stream);
	lastw = separator;
      } else {
	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;
	  }
	  writeTerm(from_pointer(RepAppl(t) + op, &nrwt, wglb), 999, depth + 1,
		    FALSE, wglb, &nrwt);
	  restore_from_write(&nrwt, wglb);
	  if (op != Arity) {
	    wrputc(',', wglb->stream);
	    lastw = separator;
	  }
	}
	wrclose_bracket(wglb, TRUE);
      }
    }
  }

  void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
		   int priority)
  /* term to be written			 */
  /* consumer				 */
  /* write options			 */
  {
    CACHE_REGS
      struct write_globs wglb;
    struct rewind_term rwt;
    yhandle_t sls = Yap_CurrentSlot();

    if (!mywrite) {
      CACHE_REGS
	wglb.stream = GLOBAL_Stream + LOCAL_c_error_stream;
    } else
      wglb.stream = mywrite;
    wglb.lw = start;
    wglb.last_atom_minus = FALSE;
    wglb.Quote_illegal = flags & Quote_illegal_f;
    wglb.Handle_vars = flags & Handle_vars_f;
    wglb.Use_portray = flags & Use_portray_f;
    wglb.Portray_delays = flags & AttVar_Portray_f;
    wglb.MaxDepth = max_depth;
    wglb.MaxArgs = max_depth;
    /* notice: we must have ASP well set when using portray, otherwise
       we cannot make recursive Prolog calls */
    wglb.Keep_terms = (flags & (Use_portray_f | To_heap_f));
    /* initialize wglb */
    rwt.parent = NULL;
    wglb.Ignore_ops = flags & Ignore_ops_f;
    wglb.Write_strings = flags & BackQuote_String_f;
    /* protect slots for portray */
    writeTerm(from_pointer(&t, &rwt, &wglb), 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);
      }
    }
    restore_from_write(&rwt, &wglb);
    Yap_CloseSlots(sls);
  }

  char *Yap_TermToString(Term t, encoding_t enc, int flags) {
    CACHE_REGS
      int sno = Yap_open_buf_write_stream(enc, flags);
    const char *sf;
    DBTerm *e = LOCAL_BallTerm;

    if (sno < 0)
      return NULL;
    LOCAL_c_output_stream = sno;
    if (enc)
      GLOBAL_Stream[sno].encoding = enc;
    else
      GLOBAL_Stream[sno].encoding = LOCAL_encoding;
    Yap_plwrite(t, GLOBAL_Stream + sno, 0, flags, GLOBAL_MaxPriority);

    sf = Yap_MemExportStreamPtr(sno);
    size_t len = strlen(sf);
    char *new = malloc( len + 1 );
    strcpy( new, sf );
    Yap_CloseStream(sno);
    if (e)
      LOCAL_BallTerm = e;
    return new;
  }