800 lines
		
	
	
		
			19 KiB
		
	
	
	
		
			C
		
	
	
	
	
	
			
		
		
	
	
			800 lines
		
	
	
		
			19 KiB
		
	
	
	
		
			C
		
	
	
	
	
	
/*  $Id$
 | 
						|
 | 
						|
    Part of SWI-Prolog
 | 
						|
 | 
						|
    Author:        Jan Wielemaker
 | 
						|
    E-mail:        J.Wielemaker@cs.vu.nl
 | 
						|
    WWW:           http://www.swi-prolog.org
 | 
						|
    Copyright (C): 1985-2010, University of Amsterdam
 | 
						|
			      Vu University Amsterdam
 | 
						|
 | 
						|
    This library is free software; you can redistribute it and/or
 | 
						|
    modify it under the terms of the GNU Lesser General Public
 | 
						|
    License as published by the Free Software Foundation; either
 | 
						|
    version 2.1 of the License, or (at your option) any later version.
 | 
						|
 | 
						|
    This library is distributed in the hope that it will be useful,
 | 
						|
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
						|
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 | 
						|
    Lesser General Public License for more details.
 | 
						|
 | 
						|
    You should have received a copy of the GNU Lesser General Public
 | 
						|
    License along with this library; if not, write to the Free Software
 | 
						|
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 | 
						|
*/
 | 
						|
 | 
						|
/** @defgroup Write Outputting a term to a Stream
 | 
						|
 *  @ingroup InputOutput
 | 
						|
 *
 | 
						|
 * @brief Predicates that output a term to a stream. The predicates
 | 
						|
 * call upon write_term/3 to do the actual work. They differ on the
 | 
						|
 * parameters being used
 | 
						|
 * whether they write to user_output or to an user-specified stream.
 | 
						|
 *
 | 
						|
 * @{
 | 
						|
 */
 | 
						|
#include <math.h>
 | 
						|
#include "pl-incl.h"
 | 
						|
#include "pl-dtoa.h"
 | 
						|
#include "pl-ctype.h"
 | 
						|
#include <stdio.h>			/* sprintf() */
 | 
						|
#ifdef HAVE_LOCALE_H
 | 
						|
#include <locale.h>
 | 
						|
#endif
 | 
						|
#ifdef HAVE_FLOAT_H
 | 
						|
#include <float.h>
 | 
						|
#endif
 | 
						|
#ifdef HAVE_IEEEFP_H
 | 
						|
#include <ieeefp.h>
 | 
						|
#endif
 | 
						|
 | 
						|
#ifdef fpclassify
 | 
						|
#define HAVE_FPCLASSIFY 1
 | 
						|
#endif
 | 
						|
 | 
						|
#if __YAP_PROLOG__
 | 
						|
 | 
						|
#define _PL_WRITE_ 1
 | 
						|
 | 
						|
#include "yapio.h"
 | 
						|
 | 
						|
#endif
 | 
						|
 | 
						|
typedef struct visited
 | 
						|
{ Word address;				/* we have done this address */
 | 
						|
  struct visited *next;			/* next already visited */
 | 
						|
} visited;
 | 
						|
 | 
						|
typedef struct
 | 
						|
{ int   flags;				/* PL_WRT_* flags */
 | 
						|
  int   max_depth;			/* depth limit */
 | 
						|
  int   depth;				/* current depth */
 | 
						|
  atom_t spacing;			/* Where to insert spaces */
 | 
						|
  module_t module;			/* Module for operators */
 | 
						|
  IOSTREAM *out;			/* stream to write to */
 | 
						|
  term_t portray_goal;			/* call/2 activated portray hook */
 | 
						|
  term_t write_options;			/* original write options */
 | 
						|
  term_t prec_opt;			/* term in write options with prec */
 | 
						|
} write_options;
 | 
						|
 | 
						|
/** @pred  nl(+ _S_) is iso
 | 
						|
 | 
						|
Outputs a new line to stream  _S_.
 | 
						|
 */
 | 
						|
/// @memberof nl/1
 | 
						|
word
 | 
						|
pl_nl1(term_t stream)
 | 
						|
{ GET_LD
 | 
						|
  IOSTREAM *s;
 | 
						|
 | 
						|
  if ( getTextOutputStream(stream, &s) )
 | 
						|
  { Sputcode('\n', s);
 | 
						|
    return streamStatus(s);
 | 
						|
  }
 | 
						|
 | 
						|
  fail;
 | 
						|
}
 | 
						|
 | 
						|
/** @pred  nl is iso
 | 
						|
 | 
						|
Outputs a new line to the current output stream.
 | 
						|
 | 
						|
 */
 | 
						|
/// @memberof  nl/0
 | 
						|
word
 | 
						|
pl_nl(void)
 | 
						|
{ return pl_nl1(0);
 | 
						|
}
 | 
						|
 | 
						|
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 | 
						|
Formatting a float. This used  to  use   sprintf(),  but  there  are two
 | 
						|
problems with this. First of all, this uses the current locale, which is
 | 
						|
complicated to avoid. Second, it does not provide a mode that guarantees
 | 
						|
reliable read-back. Using %g gets closest,   but %.15g doesn't guarantee
 | 
						|
read-back and %.17g does, but prints 0.1 as 0.100..001, etc.
 | 
						|
 | 
						|
This uses dtoa.c. See pl-dtoa.c for how this is packed into SWI-Prolog.
 | 
						|
 | 
						|
TBD: The number of cases are large. We should see whether it is possible
 | 
						|
to clean this up a bit. The 5 cases   as  such are real: there is no way
 | 
						|
around these.
 | 
						|
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 | 
						|
 | 
						|
char *
 | 
						|
format_float(double f, char *buf)
 | 
						|
{ char *end, *o=buf;
 | 
						|
  int decpt, sign;
 | 
						|
  char *s = dtoa(f, 0, 30, &decpt, &sign, &end);
 | 
						|
 | 
						|
  DEBUG(2, Sdprintf("decpt=%d, sign=%d, len = %d, '%s'\n",
 | 
						|
		    decpt, sign, end-s, s));
 | 
						|
 | 
						|
  if ( sign )
 | 
						|
    *o++ = '-';
 | 
						|
 | 
						|
  if ( decpt <= 0 )			/* decimal dot before */
 | 
						|
  { if ( decpt <= -4 )
 | 
						|
    { *o++ = s[0];
 | 
						|
      *o++ = '.';
 | 
						|
      if ( end-s > 1 )
 | 
						|
      { memcpy(o, s+1, end-s-1);
 | 
						|
	o += end-s-1;
 | 
						|
      } else
 | 
						|
	*o++ = '0';
 | 
						|
      sprintf(o, "e%d", decpt-1);
 | 
						|
    } else
 | 
						|
    { int i;
 | 
						|
 | 
						|
      *o++ = '0';
 | 
						|
      *o++ = '.';
 | 
						|
      for(i=0; i < -decpt; i++)
 | 
						|
	*o++ = '0';
 | 
						|
      memcpy(o, s, end-s);
 | 
						|
      o[end-s] = 0;
 | 
						|
    }
 | 
						|
  } else if ( end-s > decpt )		/* decimal dot inside */
 | 
						|
  { memcpy(o, s, decpt);
 | 
						|
    o += decpt;
 | 
						|
    *o++ = '.';
 | 
						|
    memcpy(o, s+decpt, end-s-decpt);
 | 
						|
    o[end-s-decpt] = 0;
 | 
						|
  } else				/* decimal dot after */
 | 
						|
  { int i;
 | 
						|
    int trailing = decpt-(int)(end-s);
 | 
						|
 | 
						|
    if ( decpt > 15 )			/* over precision: use eE */
 | 
						|
    { *o++ = s[0];
 | 
						|
      *o++ = '.';
 | 
						|
      if ( end-s > 1 )
 | 
						|
      { trailing += (int)(end-s)-1;
 | 
						|
	memcpy(o, s+1, end-s-1);
 | 
						|
	o += end-s-1;
 | 
						|
      } else
 | 
						|
	*o++ = '0';
 | 
						|
      sprintf(o, "e+%d", trailing);
 | 
						|
    } else				/* within precision trail with .0 */
 | 
						|
    { memcpy(o, s, end-s);
 | 
						|
      o += end-s;
 | 
						|
 | 
						|
      for(i=(int)(end-s); i<decpt; i++)
 | 
						|
	*o++ = '0';
 | 
						|
      *o++ = '.';
 | 
						|
      *o++ = '0';
 | 
						|
      *o = 0;
 | 
						|
    }
 | 
						|
  }
 | 
						|
 | 
						|
  freedtoa(s);
 | 
						|
 | 
						|
  return buf;
 | 
						|
}
 | 
						|
 | 
						|
static int
 | 
						|
bind_varnames(term_t varnames ARG_LD)
 | 
						|
{
 | 
						|
  CACHE_REGS
 | 
						|
  Term t = Yap_GetFromSlot(varnames);
 | 
						|
  while(!IsVarTerm(t) && IsPairTerm(t)) {
 | 
						|
    Term tl = HeadOfTerm(t);
 | 
						|
    Functor f;
 | 
						|
    Term tv, t2, t1;
 | 
						|
 | 
						|
    if (!IsApplTerm(tl)) return FALSE;
 | 
						|
    if ((f = FunctorOfTerm(tl)) != FunctorEq) {
 | 
						|
      return FALSE;
 | 
						|
    }
 | 
						|
    t1 = ArgOfTerm(1, tl);
 | 
						|
    if (IsVarTerm(t1)) {
 | 
						|
      return PL_error(NULL, 0, "variable_names", ERR_INSTANTIATION, 0, t1);
 | 
						|
    }
 | 
						|
    t2 = ArgOfTerm(2, tl);
 | 
						|
    tv = Yap_MkApplTerm(LOCAL_FunctorVar, 1, &t1);
 | 
						|
    if (IsVarTerm(t2)) {
 | 
						|
      Bind_and_Trail(VarOfTerm(t2), tv);
 | 
						|
    }
 | 
						|
    t = TailOfTerm(t);
 | 
						|
  }
 | 
						|
  return TRUE;
 | 
						|
}
 | 
						|
 | 
						|
char *
 | 
						|
varName(term_t t, char *name)
 | 
						|
{
 | 
						|
  CACHE_REGS
 | 
						|
  CELL *adr = (CELL *)Yap_GetFromSlot(t);
 | 
						|
 | 
						|
  if (IsAttVar(adr)) {
 | 
						|
    Ssprintf(name, "_D%ld", (CELL)adr - (CELL)H0);
 | 
						|
  } else {
 | 
						|
    Ssprintf(name, "_%ld", (CELL)adr - (CELL)H0);
 | 
						|
  }
 | 
						|
 | 
						|
  return name;
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
static bool
 | 
						|
writeTopTerm(term_t t, int prec, write_options *options)
 | 
						|
{
 | 
						|
  CACHE_REGS
 | 
						|
  UInt yap_flag = Use_SWI_Stream_f;
 | 
						|
  int flags = options->flags;
 | 
						|
  Term old_module;
 | 
						|
 | 
						|
  if (flags & PL_WRT_QUOTED)
 | 
						|
    yap_flag |= Quote_illegal_f;
 | 
						|
  if (options->flags & PL_WRT_NUMBERVARS)
 | 
						|
    yap_flag |=  Handle_vars_f;
 | 
						|
  if (options->flags & PL_WRT_VARNAMES)
 | 
						|
    yap_flag |=  Handle_vars_f;
 | 
						|
  if (options->flags & PL_WRT_IGNOREOPS)
 | 
						|
    yap_flag |= Ignore_ops_f;
 | 
						|
  if (flags & PL_WRT_PORTRAY)
 | 
						|
    yap_flag |= Use_portray_f;
 | 
						|
  if (flags & PL_WRT_BACKQUOTED_STRING)
 | 
						|
    yap_flag |= BackQuote_String_f;
 | 
						|
  if (flags & PL_WRT_ATTVAR_IGNORE)
 | 
						|
    yap_flag |= 0L;
 | 
						|
  if (flags & PL_WRT_ATTVAR_DOTS)
 | 
						|
    yap_flag |= AttVar_Dots_f;
 | 
						|
  if (flags & PL_WRT_ATTVAR_PORTRAY)
 | 
						|
    yap_flag |= AttVar_Portray_f;
 | 
						|
  if (flags & PL_WRT_BLOB_PORTRAY)
 | 
						|
    yap_flag |= Blob_Portray_f;
 | 
						|
  old_module = CurrentModule;
 | 
						|
 | 
						|
  CurrentModule = Yap_GetModuleFromEntry(options->module);
 | 
						|
 | 
						|
Yap_plwrite(Yap_GetFromSlot(t), options->out, options->max_depth, yap_flag, prec);
 | 
						|
  CurrentModule = old_module;
 | 
						|
  return TRUE;
 | 
						|
}
 | 
						|
 | 
						|
int
 | 
						|
writeAtomToStream(IOSTREAM *s, atom_t atom)
 | 
						|
{ Yap_WriteAtom( s, YAP_AtomFromSWIAtom(atom));
 | 
						|
  return 1;
 | 
						|
}
 | 
						|
 | 
						|
static int
 | 
						|
writeBlobMask(atom_t a)
 | 
						|
{ if ( a == ATOM_default )
 | 
						|
  { return 0;
 | 
						|
  } else if ( a == ATOM_portray )
 | 
						|
  { return PL_WRT_BLOB_PORTRAY;
 | 
						|
  } else
 | 
						|
    return -1;
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 | 
						|
PutOpenToken() inserts a space in the output stream if the last-written
 | 
						|
and given character require a space to ensure a token-break.
 | 
						|
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 | 
						|
 | 
						|
#define TRUE_WITH_SPACE 2		/* OK, and emitted leading space before token */
 | 
						|
 | 
						|
static bool
 | 
						|
Putc(int c, IOSTREAM *s)
 | 
						|
{ return Sputcode(c, s) == EOF ? FALSE : TRUE;
 | 
						|
}
 | 
						|
 | 
						|
#define LAST_C_RESERVED		0x110000 /* Above Unicode range */
 | 
						|
#define PREFIX_SIGN		(LAST_C_RESERVED+1)
 | 
						|
 | 
						|
#define isquote(c) ((c) == '\'' || (c) == '"')
 | 
						|
 | 
						|
static bool
 | 
						|
needSpace(int c, IOSTREAM *s)
 | 
						|
{ if ( c == EOF )
 | 
						|
  { s->lastc = EOF;
 | 
						|
    return FALSE;
 | 
						|
  }
 | 
						|
 | 
						|
  if ( s->lastc == PREFIX_SIGN )	/* avoid passing to is*W() functions */
 | 
						|
  { if ( isDigit(c) || isSymbolW(c) )
 | 
						|
      return TRUE;
 | 
						|
    return FALSE;
 | 
						|
  }
 | 
						|
 | 
						|
  if ( s->lastc != EOF &&
 | 
						|
       ((isAlphaW(s->lastc) && isAlphaW(c)) ||
 | 
						|
	(isSymbolW(s->lastc) && isSymbolW(c)) ||
 | 
						|
	(s->lastc != '(' && !isBlank(s->lastc) && c == '(') ||
 | 
						|
	(c == '\'' && (isDigit(s->lastc))) ||
 | 
						|
	(isquote(c) && s->lastc == c)
 | 
						|
       ) )
 | 
						|
    return TRUE;
 | 
						|
 | 
						|
  return FALSE;
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
static int
 | 
						|
PutOpenToken(int c, IOSTREAM *s)
 | 
						|
{ if ( needSpace(c, s) )
 | 
						|
  { TRY(Putc(' ', s));
 | 
						|
    return TRUE_WITH_SPACE;
 | 
						|
  }
 | 
						|
 | 
						|
  return TRUE;
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
 | 
						|
		 /*******************************
 | 
						|
		 *	      TOPLEVEL		*
 | 
						|
		 *******************************/
 | 
						|
 | 
						|
int
 | 
						|
writeAttributeMask(atom_t a)
 | 
						|
{ if ( a == ATOM_ignore )
 | 
						|
  { return PL_WRT_ATTVAR_IGNORE;
 | 
						|
  } else if ( a == ATOM_dots )
 | 
						|
  { return PL_WRT_ATTVAR_DOTS;
 | 
						|
  } else if ( a == ATOM_write )
 | 
						|
  { return PL_WRT_ATTVAR_WRITE;
 | 
						|
  } else if ( a == ATOM_portray )
 | 
						|
  { return PL_WRT_ATTVAR_PORTRAY;
 | 
						|
  } else
 | 
						|
    return 0;
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
static const opt_spec write_term_options[] =
 | 
						|
{ { ATOM_quoted,	    OPT_BOOL },
 | 
						|
  { ATOM_ignore_ops,	    OPT_BOOL },
 | 
						|
  { ATOM_numbervars,        OPT_BOOL },
 | 
						|
  { ATOM_portray,           OPT_BOOL },
 | 
						|
  { ATOM_portray_goal,      OPT_TERM },
 | 
						|
  { ATOM_character_escapes, OPT_BOOL },
 | 
						|
  { ATOM_max_depth,	    OPT_INT  },
 | 
						|
  { ATOM_module,	    OPT_ATOM },
 | 
						|
  { ATOM_backquoted_string, OPT_BOOL },
 | 
						|
  { ATOM_attributes,	    OPT_ATOM },
 | 
						|
  { ATOM_priority,	    OPT_INT },
 | 
						|
  { ATOM_partial,	    OPT_BOOL },
 | 
						|
  { ATOM_spacing,	    OPT_ATOM },
 | 
						|
  { ATOM_blobs,		    OPT_ATOM },
 | 
						|
  { ATOM_cycles,	    OPT_BOOL },
 | 
						|
  { ATOM_variable_names,    OPT_TERM },
 | 
						|
  { NULL_ATOM,		    0 }
 | 
						|
};
 | 
						|
 | 
						|
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 | 
						|
Call user:portray/1 if defined.
 | 
						|
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 | 
						|
 | 
						|
static int
 | 
						|
put_write_options(term_t opts_in, write_options *options)
 | 
						|
{ GET_LD
 | 
						|
  term_t newlist = PL_new_term_ref();
 | 
						|
  term_t precopt = PL_new_term_ref();
 | 
						|
  fid_t fid = PL_open_foreign_frame();
 | 
						|
  term_t head = PL_new_term_ref();
 | 
						|
  term_t tail = PL_copy_term_ref(opts_in);
 | 
						|
  term_t newhead = PL_new_term_ref();
 | 
						|
  term_t newtail = PL_copy_term_ref(newlist);
 | 
						|
  int rc = TRUE;
 | 
						|
 | 
						|
  while(rc && PL_get_list(tail, head, tail))
 | 
						|
  { if ( !PL_is_functor(head, FUNCTOR_priority1) )
 | 
						|
      rc = ( PL_unify_list(newtail, newhead, newtail) &&
 | 
						|
	     PL_unify(newhead, head) );
 | 
						|
  }
 | 
						|
 | 
						|
  if ( rc )
 | 
						|
  { rc = ( PL_unify_list(newtail, head, newtail) &&
 | 
						|
	   PL_unify_functor(head, FUNCTOR_priority1) &&
 | 
						|
	   PL_get_arg(1, head, precopt) &&
 | 
						|
	   PL_unify_nil(newtail) );
 | 
						|
  }
 | 
						|
  if ( rc )
 | 
						|
  { options->write_options = newlist;
 | 
						|
    options->prec_opt = precopt;
 | 
						|
  }
 | 
						|
 | 
						|
  PL_close_foreign_frame(fid);
 | 
						|
  return rc;
 | 
						|
}
 | 
						|
 | 
						|
word
 | 
						|
pl_write_term3(term_t stream, term_t term, term_t opts)
 | 
						|
{ GET_LD
 | 
						|
  bool quoted     = FALSE;
 | 
						|
  bool ignore_ops = FALSE;
 | 
						|
  int numbervars = -1;			/* not set */
 | 
						|
  bool portray    = FALSE;
 | 
						|
  term_t gportray = 0;
 | 
						|
  bool bqstring   = truePrologFlag(PLFLAG_BACKQUOTED_STRING);
 | 
						|
  int charescape = -1;			/* not set */
 | 
						|
  atom_t mname    = ATOM_user;
 | 
						|
  atom_t attr     = ATOM_nil;
 | 
						|
  atom_t blobs    = ATOM_nil;
 | 
						|
  int  priority   = 1200;
 | 
						|
  bool partial    = FALSE;
 | 
						|
  bool cycles     = TRUE;
 | 
						|
  term_t varnames = 0;
 | 
						|
  int local_varnames;
 | 
						|
  IOSTREAM *s = NULL;
 | 
						|
  write_options options;
 | 
						|
  int rc;
 | 
						|
 | 
						|
  memset(&options, 0, sizeof(options));
 | 
						|
  options.spacing = ATOM_standard;
 | 
						|
 | 
						|
  if ( !scan_options(opts, 0, ATOM_write_option, write_term_options,
 | 
						|
		     "ed, &ignore_ops, &numbervars, &portray, &gportray,
 | 
						|
		     &charescape, &options.max_depth, &mname,
 | 
						|
		     &bqstring, &attr, &priority, &partial, &options.spacing,
 | 
						|
		     &blobs, &cycles, &varnames) )
 | 
						|
    fail;
 | 
						|
 | 
						|
  if ( attr == ATOM_nil )
 | 
						|
  { options.flags |= LD->prolog_flag.write_attributes;
 | 
						|
  } else
 | 
						|
  { int mask = writeAttributeMask(attr);
 | 
						|
 | 
						|
    if ( !mask )
 | 
						|
      return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_write_option, opts);
 | 
						|
 | 
						|
    options.flags |= mask;
 | 
						|
  }
 | 
						|
  if ( blobs != ATOM_nil )
 | 
						|
  { int mask = writeBlobMask(blobs);
 | 
						|
 | 
						|
    if ( mask < 0 )
 | 
						|
      return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_write_option, opts);
 | 
						|
 | 
						|
    options.flags |= mask;
 | 
						|
  }
 | 
						|
  if ( priority < 0 || priority > OP_MAXPRIORITY )
 | 
						|
  { term_t t = PL_new_term_ref();
 | 
						|
    PL_put_integer(t, priority);
 | 
						|
 | 
						|
    return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_operator_priority, t);
 | 
						|
  }
 | 
						|
  switch( options.spacing )
 | 
						|
  { case ATOM_standard:
 | 
						|
    case ATOM_next_argument:
 | 
						|
      break;
 | 
						|
    default:
 | 
						|
    { term_t t = PL_new_term_ref();
 | 
						|
      PL_put_atom(t, options.spacing);
 | 
						|
 | 
						|
      return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_spacing, t);
 | 
						|
    }
 | 
						|
  }
 | 
						|
 | 
						|
  options.module = lookupModule(mname);
 | 
						|
  if ( charescape == TRUE ||
 | 
						|
       (charescape == -1
 | 
						|
#ifndef __YAP_PROLOG__
 | 
						|
&& True(options.module, M_CHARESCAPE)
 | 
						|
#endif
 | 
						|
	) )
 | 
						|
    options.flags |= PL_WRT_CHARESCAPES;
 | 
						|
  if ( gportray )
 | 
						|
  { options.portray_goal = gportray;
 | 
						|
    if ( !put_write_options(opts, &options) ||
 | 
						|
	 !PL_qualify(options.portray_goal, options.portray_goal) )
 | 
						|
      return FALSE;
 | 
						|
    portray = TRUE;
 | 
						|
  }
 | 
						|
  if ( numbervars == -1 )
 | 
						|
    numbervars = (portray ? TRUE : FALSE);
 | 
						|
 | 
						|
  if ( quoted )     options.flags |= PL_WRT_QUOTED;
 | 
						|
  if ( ignore_ops ) options.flags |= PL_WRT_IGNOREOPS;
 | 
						|
  if ( numbervars ) options.flags |= PL_WRT_NUMBERVARS;
 | 
						|
  if ( portray )    options.flags |= PL_WRT_PORTRAY;
 | 
						|
  if ( bqstring )   options.flags |= PL_WRT_BACKQUOTED_STRING;
 | 
						|
  if ( !cycles )    options.flags |= PL_WRT_NO_CYCLES;
 | 
						|
 | 
						|
  local_varnames = (varnames && False(&options, PL_WRT_NUMBERVARS));
 | 
						|
 | 
						|
  BEGIN_NUMBERVARS(local_varnames);
 | 
						|
  if ( varnames )
 | 
						|
      { if ( (rc=bind_varnames(varnames PASS_LD)) )
 | 
						|
      options.flags |= PL_WRT_VARNAMES;
 | 
						|
    else
 | 
						|
      goto out;
 | 
						|
  }
 | 
						|
  if ( !(rc=getTextOutputStream(stream, &s)) )
 | 
						|
    goto out;
 | 
						|
 | 
						|
  options.out = s;
 | 
						|
  if ( !partial )
 | 
						|
    PutOpenToken(EOF, s);		/* reset this */
 | 
						|
  if ( (options.flags & PL_WRT_QUOTED) && !(s->flags&SIO_REPPL) )
 | 
						|
  { s->flags |= SIO_REPPL;
 | 
						|
    rc = writeTopTerm(term, priority, &options);
 | 
						|
    s->flags &= ~SIO_REPPL;
 | 
						|
  } else
 | 
						|
  { rc = writeTopTerm(term, priority, &options);
 | 
						|
  }
 | 
						|
 | 
						|
out:
 | 
						|
  END_NUMBERVARS(local_varnames);
 | 
						|
 | 
						|
  return (!s || streamStatus(s)) && rc;
 | 
						|
}
 | 
						|
 | 
						|
/** @pred  write_term(+ _S_, + _T_, + _Opts_) is iso
 | 
						|
 | 
						|
Displays term  _T_ on the current output stream, according to the same
 | 
						|
options used by `write_term/3`.
 | 
						|
 | 
						|
 | 
						|
*/
 | 
						|
/// @memberof write_term/3
 | 
						|
word
 | 
						|
pl_write_term(term_t term, term_t options)
 | 
						|
{ return pl_write_term3(0, term, options);
 | 
						|
}
 | 
						|
 | 
						|
/** @pred  write_term(+ _T_, + _Opts_) is iso
 | 
						|
 | 
						|
 | 
						|
    Displays term  _T_ on the current output stream, according to the
 | 
						|
following options:
 | 
						|
 | 
						|
+ quoted(+ _Bool_) is iso
 | 
						|
 | 
						|
    If `true`, quote atoms if this would be necessary for the atom to
 | 
						|
be recognized as an atom by YAP's parser. The default value is
 | 
						|
`false`.
 | 
						|
 | 
						|
+ ignore_ops(+ _Bool_) is iso
 | 
						|
 | 
						|
   If `true`, ignore operator declarations when writing the term. The
 | 
						|
default value is `false`.
 | 
						|
 | 
						|
+ numbervars(+ _Bool_) is iso
 | 
						|
 | 
						|
    If `true`, output terms of the form
 | 
						|
`$VAR(N)`, where  _N_ is an integer, as a sequence of capital
 | 
						|
letters. The default value is `false`.
 | 
						|
 | 
						|
+ portrayed(+ _Bool_)
 | 
						|
 | 
						|
    If `true`, use <tt>portray/1</tt> to portray bound terms. The default
 | 
						|
value is `false`.
 | 
						|
 | 
						|
+ portray(+ _Bool_)
 | 
						|
 | 
						|
    If `true`, use <tt>portray/1</tt> to portray bound terms. The default
 | 
						|
value is `false`.
 | 
						|
 | 
						|
+ max_depth(+ _Depth_)
 | 
						|
 | 
						|
    If `Depth` is a positive integer, use <tt>Depth</tt> as
 | 
						|
the maximum depth to portray a term. The default is `0`, that is,
 | 
						|
unlimited depth.
 | 
						|
 | 
						|
+ priority(+ _Piority_)
 | 
						|
 | 
						|
    If `Priority` is a positive integer smaller than `1200`,
 | 
						|
give the context priority. The default is `1200`.
 | 
						|
 | 
						|
+ cycles(+ _Bool_)
 | 
						|
 | 
						|
    Do not loop in rational trees (default).
 | 
						|
 | 
						|
*/
 | 
						|
/// @memberof write_term/2
 | 
						|
int
 | 
						|
PL_write_term(IOSTREAM *s, term_t term, int precedence, int flags)
 | 
						|
{ write_options options;
 | 
						|
 | 
						|
  memset(&options, 0, sizeof(options));
 | 
						|
  options.flags	    = flags;
 | 
						|
  options.out	    = s;
 | 
						|
  options.module    = MODULE_user;
 | 
						|
  PutOpenToken(EOF, s);			/* reset this */
 | 
						|
  return writeTopTerm(term, precedence, &options);
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
static word
 | 
						|
do_write2(term_t stream, term_t term, int flags)
 | 
						|
{ GET_LD
 | 
						|
  IOSTREAM *s;
 | 
						|
 | 
						|
  if ( getTextOutputStream(stream, &s) )
 | 
						|
  { write_options options;
 | 
						|
    int rc;
 | 
						|
 | 
						|
    memset(&options, 0, sizeof(options));
 | 
						|
    options.flags     = flags;
 | 
						|
    options.out	      = s;
 | 
						|
    options.module    = MODULE_user;
 | 
						|
    if ( options.module
 | 
						|
#ifndef __YAP_PROLOG__
 | 
						|
	 && True(options.module, M_CHARESCAPE)
 | 
						|
#endif
 | 
						|
	 )
 | 
						|
      options.flags |= PL_WRT_CHARESCAPES;
 | 
						|
    if ( truePrologFlag(PLFLAG_BACKQUOTED_STRING) )
 | 
						|
      options.flags |= PL_WRT_BACKQUOTED_STRING;
 | 
						|
 | 
						|
    PutOpenToken(EOF, s);		/* reset this */
 | 
						|
    rc = writeTopTerm(term, 1200, &options);
 | 
						|
    if ( rc && (flags&PL_WRT_NEWLINE) )
 | 
						|
      rc = Putc('\n', s);
 | 
						|
 | 
						|
    return streamStatus(s) && rc;
 | 
						|
  }
 | 
						|
 | 
						|
  return FALSE;
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
/** @pred  write(+ _S_, _T_) is iso
 | 
						|
 | 
						|
Writes term  _T_ to stream  _S_ instead of to the current output
 | 
						|
stream.
 | 
						|
 | 
						|
 | 
						|
*/
 | 
						|
/// @memberof write/2
 | 
						|
word
 | 
						|
pl_write2(term_t stream, term_t term)
 | 
						|
{ return do_write2(stream, term, PL_WRT_NUMBERVARS);
 | 
						|
}
 | 
						|
 | 
						|
/** @pred  writeq(+ _S_, _T_) is iso
 | 
						|
 | 
						|
As writeq/1, but the output is sent to the stream  _S_.
 | 
						|
 | 
						|
 | 
						|
*/
 | 
						|
/// @memberof writeq/2
 | 
						|
word
 | 
						|
pl_writeq2(term_t stream, term_t term)
 | 
						|
{ return do_write2(stream, term, PL_WRT_QUOTED|PL_WRT_NUMBERVARS);
 | 
						|
}
 | 
						|
 | 
						|
/** @pred  print(+ _S_, _T_)
 | 
						|
 | 
						|
Prints term  _T_ to the stream  _S_ instead of to the current output
 | 
						|
stream.
 | 
						|
 | 
						|
 | 
						|
*/
 | 
						|
/// @memberof print/2
 | 
						|
word
 | 
						|
pl_print2(term_t stream, term_t term)
 | 
						|
{ return do_write2(stream, term,
 | 
						|
		   PL_WRT_PORTRAY|PL_WRT_NUMBERVARS);
 | 
						|
}
 | 
						|
 | 
						|
/** @pred  write_canonical(+ _S_,+ _T_) is iso
 | 
						|
 | 
						|
Displays term  _T_ on the stream  _S_. Atoms are quoted when
 | 
						|
necessary, and operators are ignored.
 | 
						|
 | 
						|
 | 
						|
*/
 | 
						|
/// @memberof write_canonical/2
 | 
						|
word
 | 
						|
pl_write_canonical2(term_t stream, term_t term)
 | 
						|
{ GET_LD
 | 
						|
  nv_options options;
 | 
						|
  word rc;
 | 
						|
 | 
						|
  BEGIN_NUMBERVARS(TRUE);
 | 
						|
 | 
						|
  options.functor = FUNCTOR_isovar1;
 | 
						|
  options.on_attvar = AV_SKIP;
 | 
						|
  options.singletons = PL_is_acyclic(term);
 | 
						|
  options.numbered_check = FALSE;
 | 
						|
 | 
						|
  rc = ( numberVars(term, &options, 0 PASS_LD) >= 0 &&
 | 
						|
	 do_write2(stream, term,
 | 
						|
		   PL_WRT_QUOTED|PL_WRT_IGNOREOPS|PL_WRT_NUMBERVARS|PLFLAG_BACKQUOTED_STRING)
 | 
						|
       );
 | 
						|
 | 
						|
  END_NUMBERVARS(TRUE);
 | 
						|
 | 
						|
  return rc;
 | 
						|
}
 | 
						|
 | 
						|
/** @pred  write( _T_) is iso
 | 
						|
 | 
						|
 | 
						|
The term  _T_ is written to the current output stream according to
 | 
						|
the operator declarations in force.
 | 
						|
*/
 | 
						|
/// @memberof write/1
 | 
						|
word
 | 
						|
pl_write(term_t term)
 | 
						|
{ return pl_write2(0, term);
 | 
						|
}
 | 
						|
 | 
						|
word
 | 
						|
/** @pred  writeq( _T_) is iso
 | 
						|
 | 
						|
Writes the term  _T_, quoting names to make the result acceptable to
 | 
						|
the predicate `read` whenever necessary.
 | 
						|
*/
 | 
						|
/// @memberof writeq/1
 | 
						|
pl_writeq(term_t term)
 | 
						|
{ return pl_writeq2(0, term);
 | 
						|
}
 | 
						|
 | 
						|
/** @pred  print( _T_)
 | 
						|
 | 
						|
 | 
						|
Prints the term  _T_ to the current output stream using write/1
 | 
						|
unless T is bound and a call to the user-defined  predicate
 | 
						|
`portray/1` succeeds. To do pretty  printing of terms the user should
 | 
						|
define suitable clauses for `portray/1` and use print/1.
 | 
						|
 | 
						|
 | 
						|
*/
 | 
						|
/// @memberof print/1
 | 
						|
word
 | 
						|
pl_print(term_t term)
 | 
						|
{ return pl_print2(0, term);
 | 
						|
}
 | 
						|
 | 
						|
/** @pred  write_canonical(+ _T_) is iso
 | 
						|
 | 
						|
 | 
						|
Displays term  _T_ on the current output stream. Atoms are quoted
 | 
						|
when necessary, and operators are ignored, that is, the term is written
 | 
						|
in standard parenthesized prefix notation.
 | 
						|
 | 
						|
 | 
						|
*/
 | 
						|
/// @memberof write_canonical/1
 | 
						|
word
 | 
						|
pl_write_canonical(term_t term)
 | 
						|
{ return pl_write_canonical2(0, term);
 | 
						|
}
 | 
						|
 | 
						|
/** @pred  writeln( _T_)
 | 
						|
 | 
						|
 | 
						|
Prints the term  _T_ to the current output stream using write/1,
 | 
						|
followed by a newline.
 | 
						|
 | 
						|
 | 
						|
*/
 | 
						|
/// @memberof writeln/1
 | 
						|
word
 | 
						|
pl_writeln(term_t term)
 | 
						|
{ return do_write2(0, term, PL_WRT_NUMBERVARS|PL_WRT_NEWLINE);
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
 | 
						|
		 /*******************************
 | 
						|
		 *      PUBLISH PREDICATES	*
 | 
						|
		 *******************************/
 | 
						|
/// @}
 | 
						|
 | 
						|
BeginPredDefs(write)
 | 
						|
EndPredDefs
 |