810 lines
20 KiB
C
810 lines
20 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 PASS_REGS);
|
|
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 PASS_REGS);
|
|
|
|
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;
|
|
char * buf[1024];
|
|
size_t length;
|
|
int encode; Term tn;
|
|
|
|
__android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "Yap_REGS=%p\n", Yap_REGS);
|
|
CurrentModule = Yap_GetModuleFromEntry(options->module);
|
|
|
|
__android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "t=%d\n", t) ;
|
|
|
|
__android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "LOCAl_SlotBase[t]=%ld\n", LOCAL_SlotBase[t]);
|
|
__android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, "LOCAl_SlotBase=%ld\n", Deref(LOCAL_SlotBase[t]));
|
|
|
|
|
|
Yap_plwrite(Yap_GetFromSlot(t PASS_REGS), 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
|