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

1180 lines
32 KiB
C
Raw Normal View History

2015-06-18 01:33:21 +01:00
/*************************************************************************
2016-08-15 20:50:58 +01:00
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: charcodes.c *
* Last rev: 5/2/88 *
* mods: *
* comments: Character codes and character conversion *
* *
*************************************************************************/
2015-06-18 01:33:21 +01:00
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif
2015-11-10 14:18:27 +00:00
/**
* @defgroup FormattedIO Formatted Output
* @ingroup YAPIO
* This file includes the definition of the formatted output predicates.
2015-06-18 01:33:21 +01:00
*
2015-11-10 14:18:27 +00:00
* @{
*
* @pred format(+ _T_, :_L_)
Print formatted output to the current output stream. The arguments in
list _L_ are output according to the string, list of codes or
characters, or by the atom _T_.
A control sequence is introduced by a `~`. The following control
sequences are available in YAP:
+ `~~`
Print a single tilde.
+ `~a`
The next argument must be an atom, that will be printed as if by `write`.
+ `~Nc`
The next argument must be an integer, that will be printed as a
character code. The number _N_ is the number of times to print the
character (default 1).
+ `~Ne`
+ `~NE`
+ `~Nf`
+ `~Ng`
+ `~NG`
The next argument must be a floating point number. The float _F_, the number
_N_ and the control code `c` will be passed to `printf` as:
~~~~~{.prolog}
printf("%s.Nc", F)
~~~~~
As an example:
~~~~~{.prolog}
?- format("~8e, ~8E, ~8f, ~8g, ~8G~w",
[3.14,3.14,3.14,3.14,3.14,3.14]).
3.140000e+00, 3.140000E+00, 3.140000, 3.14, 3.143.14
~~~~~
+ `~Nd`
The next argument must be an integer, and _N_ is the number of digits
after the decimal point. If _N_ is `0` no decimal points will be
printed. The default is _N = 0_.
~~~~~{.prolog}
?- format("~2d, ~d",[15000, 15000]).
150.00, 15000
~~~~~
+ `~ND`
Identical to `~Nd`, except that commas are used to separate groups
of three digits.
~~~~~{.prolog}
?- format("~2D, ~D",[150000, 150000]).
1,500.00, 150,000
~~~~~
+ `~i`
Ignore the next argument in the list of arguments:
~~~~~{.prolog}
?- format('The ~i met the boregrove',[mimsy]).
The met the boregrove
~~~~~
+ `~k`
Print the next argument with `write_canonical`:
~~~~~{.prolog}
?- format("Good night ~k",a+[1,2]).
Good night +(a,[1,2])
~~~~~
+ `~Nn`
Print _N_ newlines (where _N_ defaults to 1).
+ `~NN`
Print _N_ newlines if at the beginning of the line (where _N_
defaults to 1).
+ `~Nr`
The next argument must be an integer, and _N_ is interpreted as a
radix, such that `2 <= N <= 36` (the default is 8).
~~~~~{.prolog}
?- format("~2r, 0x~16r, ~r",
[150000, 150000, 150000]).
100100100111110000, 0x249f0, 444760
~~~~~
Note that the letters `a-z` denote digits larger than 9.
+ `~NR`
Similar to `~NR`. The next argument must be an integer, and _N_ is
interpreted as a radix, such that `2 <= N <= 36` (the default is 8).
~~~~~{.prolog}
?- format("~2r, 0x~16r, ~r",
[150000, 150000, 150000]).
100100100111110000, 0x249F0, 444760
~~~~~
The only difference is that letters `A-Z` denote digits larger than 9.
+ `~p`
Print the next argument with print/1:
~~~~~{.prolog}
?- format("Good night ~p",a+[1,2]).
Good night a+[1,2]
~~~~~
+ `~q`
Print the next argument with writeq/1:
~~~~~{.prolog}
?- format("Good night ~q",'Hello'+[1,2]).
Good night 'Hello'+[1,2]
~~~~~
+ `~Ns`
The next argument must be a list of character codes.The system then
outputs their representation as a string, where _N_ is the maximum
number of characters for the string ( _N_ defaults to the length of the
string).
~~~~~{.prolog}
?- format("The ~s are ~4s",["woods","lovely"]).
The woods are love
~~~~~
+ `~w`
Print the next argument with write/1:
~~~~~
?- format("Good night ~w",'Hello'+[1,2]).
Good night Hello+[1,2]
~~~~~
The number of arguments, `N`, may be given as an integer, or it
may be given as an extra argument. The next example shows a small
procedure to write a variable number of `a` characters:
~~~~~
write_many_as(N) :-
format("~*c",[N,0'a]).
~~~~~
The format/2 built-in also allows for formatted output. One can
specify column boundaries and fill the intermediate space by a padding
character:
+ `~N|`
Set a column boundary at position _N_, where _N_ defaults to the
current position.
+ `~N+`
Set a column boundary at _N_ characters past the current position, where
_N_ defaults to `8`.
+ `~Nt`
Set padding for a column, where _N_ is the fill code (default is
`SPC`).
The next example shows how to align columns and padding. We first show
left-alignment:
~~~~~
?- format("~n*Hello~16+*~n",[]).
*Hello *
~~~~~
Note that we reserve 16 characters for the column.
The following example shows how to do right-alignment:
~~~~~
?- format("*~tHello~16+*~n",[]).
* Hello*
~~~~~
The `~t` escape sequence forces filling before `Hello`.
We next show how to do centering:
~~~~~
?- format("*~tHello~t~16+*~n",[]).
* Hello *
~~~~~
The two `~t` escape sequence force filling both before and after
`Hello`. Space is then evenly divided between the right and the
left sides.
+ `~@`
Evaluate the next argument as a goal whose standard
output is directed to the stream used by format/2.
*/
2015-06-18 01:33:21 +01:00
#include "Yap.h"
#include "YapHeap.h"
#include "YapText.h"
2016-04-05 02:53:39 +01:00
#include "Yatom.h"
#include "yapio.h"
2015-06-18 01:33:21 +01:00
#include <stdlib.h>
2016-07-31 16:16:20 +01:00
2015-06-18 01:33:21 +01:00
#if HAVE_UNISTD_H
2016-07-31 16:16:20 +01:00
2015-06-18 01:33:21 +01:00
#include <unistd.h>
2016-07-31 16:16:20 +01:00
2015-06-18 01:33:21 +01:00
#endif
#if HAVE_STDARG_H
2016-07-31 16:16:20 +01:00
2015-06-18 01:33:21 +01:00
#include <stdarg.h>
2016-07-31 16:16:20 +01:00
2015-06-18 01:33:21 +01:00
#endif
#ifdef _WIN32
#if HAVE_IO_H
/* Windows */
#include <io.h>
2015-07-06 12:03:16 +01:00
#endif
2015-06-18 01:33:21 +01:00
#if HAVE_SOCKET
#include <winsock2.h>
#endif
#include <windows.h>
#ifndef S_ISDIR
2015-11-11 07:50:12 +00:00
#define S_ISDIR(x) (((x)&_S_IFDIR) == _S_IFDIR)
2015-06-18 01:33:21 +01:00
#endif
#endif
2016-07-31 16:16:20 +01:00
2015-06-18 01:33:21 +01:00
#include "eval.h"
2016-04-05 02:53:39 +01:00
#include "iopreds.h"
2016-09-28 01:32:27 +01:00
#include "format.h"
2015-06-18 01:33:21 +01:00
2015-11-11 07:50:12 +00:00
static int format_print_str(Int sno, Int size, Int has_size, Term args,
int (*f_putc)(int, wchar_t)) {
2015-06-18 01:33:21 +01:00
Term arghd;
2015-11-11 07:50:12 +00:00
if (IsStringTerm(args)) {
2015-09-21 23:05:36 +01:00
const unsigned char *pt = UStringOfTerm(args);
2015-11-11 07:50:12 +00:00
while (*pt && (!has_size || size > 0)) {
2015-09-21 23:05:36 +01:00
utf8proc_int32_t ch;
2016-07-31 16:16:20 +01:00
pt += get_utf8(pt, -1, &ch);
2016-08-15 20:50:58 +01:00
f_putc(sno, ch);
2015-09-21 23:05:36 +01:00
}
} else {
2015-11-11 07:50:12 +00:00
while (!has_size || size > 0) {
if (IsVarTerm(args)) {
Yap_Error(INSTANTIATION_ERROR, args, "format/2");
return FALSE;
} else if (args == TermNil) {
return TRUE;
} else if (!IsPairTerm(args)) {
Yap_Error(TYPE_ERROR_LIST, args, "format/2");
return FALSE;
}
arghd = HeadOfTerm(args);
args = TailOfTerm(args);
if (IsVarTerm(arghd)) {
Yap_Error(INSTANTIATION_ERROR, arghd, "format/2");
return FALSE;
} else if (!IsIntTerm(arghd)) {
Yap_Error(TYPE_ERROR_LIST, arghd, "format/2");
return FALSE;
}
f_putc(sno, (int)IntOfTerm(arghd));
size--;
2015-06-18 01:33:21 +01:00
}
2015-09-21 23:05:36 +01:00
}
2015-06-18 01:33:21 +01:00
return TRUE;
}
2015-11-11 07:50:12 +00:00
static Int format_copy_args(Term args, Term *targs, Int tsz) {
2015-06-18 01:33:21 +01:00
Int n = 0;
while (args != TermNil) {
if (IsVarTerm(args)) {
2015-11-11 07:50:12 +00:00
Yap_Error(INSTANTIATION_ERROR, args, "format/2");
2015-06-18 01:33:21 +01:00
return FORMAT_COPY_ARGS_ERROR;
}
if (!IsPairTerm(args)) {
2015-11-11 07:50:12 +00:00
Yap_Error(TYPE_ERROR_LIST, args, "format/2");
2015-06-18 01:33:21 +01:00
return FORMAT_COPY_ARGS_ERROR;
}
if (n == tsz)
return FORMAT_COPY_ARGS_OVERFLOW;
targs[n] = HeadOfTerm(args);
args = TailOfTerm(args);
n++;
}
return n;
}
static void
2015-08-07 22:57:53 +01:00
2016-07-31 16:16:20 +01:00
format_clean_up(int sno, int sno0, format_info *finf, const unsigned char *fstr,
const Term *targs) {
if (sno != sno0) {
2016-09-28 15:08:22 +01:00
sno = format_synch(sno, sno0, finf);
2016-05-14 11:30:42 +01:00
Yap_CloseStream(sno);
}
2015-09-21 23:05:36 +01:00
if (fstr) {
2016-07-31 16:16:20 +01:00
free((void *)fstr);
2015-09-21 23:05:36 +01:00
}
2015-06-18 01:33:21 +01:00
if (targs)
2015-09-21 23:05:36 +01:00
Yap_FreeAtomSpace((void *)targs);
2015-06-18 01:33:21 +01:00
}
2015-11-11 07:50:12 +00:00
static Int fetch_index_from_args(Term t) {
2015-06-18 01:33:21 +01:00
Int i;
2015-11-11 07:50:12 +00:00
2015-06-18 01:33:21 +01:00
if (IsVarTerm(t))
return -1;
if (!IsIntegerTerm(t))
return -1;
i = IntegerOfTerm(t);
if (i < 0)
return -1;
return i;
}
2015-11-11 07:50:12 +00:00
static wchar_t base_dig(Int dig, Int ch) {
2015-07-06 12:03:16 +01:00
if (dig < 10)
2015-11-11 07:50:12 +00:00
return dig + '0';
2015-06-18 01:33:21 +01:00
else if (ch == 'r')
2015-11-11 07:50:12 +00:00
return (dig - 10) + 'a';
2015-06-18 01:33:21 +01:00
else /* ch == 'R' */
2015-11-11 07:50:12 +00:00
return (dig - 10) + 'A';
2015-06-18 01:33:21 +01:00
}
#define TMP_STRING_SIZE 1024
2015-11-11 07:50:12 +00:00
static Int doformat(volatile Term otail, volatile Term oargs,
int sno0 USES_REGS) {
2015-06-18 01:33:21 +01:00
char tmp1[TMP_STRING_SIZE], *tmpbase;
int ch;
Term mytargs[8], *targs;
Int tnum, targ;
2016-07-31 16:16:20 +01:00
const unsigned char *fstr, *fptr;
2015-06-18 01:33:21 +01:00
Term args;
Term tail;
2015-11-11 07:50:12 +00:00
int (*f_putc)(int, wchar_t);
int sno = sno0;
2015-06-18 01:33:21 +01:00
jmp_buf format_botch;
volatile void *old_handler;
volatile int old_pos;
format_info finfo;
Term fmod = CurrentModule;
2016-05-14 11:30:42 +01:00
bool alloc_fstr = false;
2016-08-15 20:50:58 +01:00
LOCAL_Error_TYPE = YAP_NO_ERROR;
2015-11-11 07:50:12 +00:00
if (GLOBAL_Stream[sno0].status & InMemory_Stream_f) {
2015-06-18 01:33:21 +01:00
old_handler = GLOBAL_Stream[sno].u.mem_string.error_handler;
GLOBAL_Stream[sno].u.mem_string.error_handler = (void *)&format_botch;
old_pos = GLOBAL_Stream[sno].u.mem_string.pos;
/* set up an error handler */
if (setjmp(format_botch)) {
restore_machine_regs();
*HR++ = oargs;
*HR++ = otail;
if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) {
2015-11-11 07:50:12 +00:00
Yap_Error(RESOURCE_ERROR_HEAP, otail, "format/2");
2016-04-28 14:57:59 +01:00
return false;
2015-06-18 01:33:21 +01:00
}
oargs = HR[-2];
otail = HR[-1];
GLOBAL_Stream[sno].u.mem_string.pos = old_pos;
HR -= 2;
}
} else {
old_handler = NULL;
}
args = oargs;
tail = otail;
targ = 0;
2016-08-15 20:50:58 +01:00
if (IsVarTerm(tail)) {
2015-11-11 07:50:12 +00:00
Yap_Error(INSTANTIATION_ERROR, tail, "format/2");
return (FALSE);
2016-07-31 16:16:20 +01:00
} else if ((fptr = Yap_TextToUTF8Buffer(tail))) {
fstr = fptr;
2016-05-14 11:30:42 +01:00
alloc_fstr = true;
2015-06-18 01:33:21 +01:00
} else {
2016-07-31 16:16:20 +01:00
Yap_Error(TYPE_ERROR_TEXT, tail, "format/2");
2016-04-28 14:57:59 +01:00
return false;
2015-06-18 01:33:21 +01:00
}
if (IsVarTerm(args)) {
Yap_Error(INSTANTIATION_ERROR, args, "format/2");
return FALSE;
2015-07-06 12:03:16 +01:00
}
2015-06-18 01:33:21 +01:00
while (IsApplTerm(args) && FunctorOfTerm(args) == FunctorModule) {
2015-11-11 07:50:12 +00:00
fmod = ArgOfTerm(1, args);
args = ArgOfTerm(2, args);
2015-06-18 01:33:21 +01:00
if (IsVarTerm(fmod)) {
Yap_Error(INSTANTIATION_ERROR, fmod, "format/2");
return FALSE;
}
if (!IsAtomTerm(fmod)) {
Yap_Error(TYPE_ERROR_ATOM, fmod, "format/2");
return FALSE;
}
if (IsVarTerm(args)) {
Yap_Error(INSTANTIATION_ERROR, args, "format/2");
return FALSE;
}
2015-07-06 12:03:16 +01:00
}
2015-06-18 01:33:21 +01:00
if (IsPairTerm(args)) {
Int tsz = 8;
2015-11-11 07:50:12 +00:00
2015-06-18 01:33:21 +01:00
targs = mytargs;
do {
tnum = format_copy_args(args, targs, tsz);
if (tnum == FORMAT_COPY_ARGS_ERROR)
2015-09-21 23:05:36 +01:00
return FALSE;
2015-06-18 01:33:21 +01:00
else if (tnum == FORMAT_COPY_ARGS_OVERFLOW) {
2016-07-31 16:16:20 +01:00
if (mytargs != targs) {
2015-09-21 23:05:36 +01:00
Yap_FreeCodeSpace((char *)targs);
}
tsz += 16;
2015-11-11 07:50:12 +00:00
targs = (Term *)Yap_AllocAtomSpace(tsz * sizeof(Term));
2015-06-18 01:33:21 +01:00
} else {
2015-09-21 23:05:36 +01:00
break;
2015-06-18 01:33:21 +01:00
}
2016-04-28 14:57:59 +01:00
} while (true);
2015-06-18 01:33:21 +01:00
} else if (args != TermNil) {
tnum = 1;
mytargs[0] = args;
targs = mytargs;
} else {
tnum = 0;
targs = mytargs;
}
2015-11-11 07:50:12 +00:00
// it starts here
finfo.gapi = 0;
finfo.phys_start = 0;
finfo.lstart = 0;
2016-07-31 16:16:20 +01:00
if (true || !(GLOBAL_Stream[sno].status & InMemory_Stream_f))
2016-09-28 15:08:22 +01:00
sno = Yap_OpenBufWriteStream(PASS_REGS1);
2016-08-15 20:50:58 +01:00
if (sno < 0) {
2016-07-31 16:16:20 +01:00
if (!alloc_fstr)
fstr = NULL;
if (mytargs == targs) {
targs = NULL;
}
format_clean_up(sno, sno0, &finfo, fstr, targs);
2016-05-14 11:30:42 +01:00
return false;
}
2016-09-28 15:08:22 +01:00
f_putc = GLOBAL_Stream[sno].stream_wputc;
2016-07-31 16:16:20 +01:00
while ((fptr += get_utf8(fptr, -1, &ch)) && ch) {
2015-06-18 01:33:21 +01:00
Term t = TermNil;
int has_repeats = false;
2015-06-18 01:33:21 +01:00
int repeats = 0;
2015-11-11 07:50:12 +00:00
2015-06-18 01:33:21 +01:00
if (ch == '~') {
/* start command */
2016-07-31 16:16:20 +01:00
fptr += get_utf8(fptr, -1, &ch);
2015-06-18 01:33:21 +01:00
if (ch == '*') {
2016-07-31 16:16:20 +01:00
fptr += get_utf8(fptr, -1, &ch);
2015-09-21 23:05:36 +01:00
has_repeats = TRUE;
2015-11-11 07:50:12 +00:00
if (targ > tnum - 1) {
2016-07-31 16:16:20 +01:00
goto do_format_control_sequence_error;
2015-09-21 23:05:36 +01:00
}
repeats = fetch_index_from_args(targs[targ++]);
if (repeats == -1)
2016-07-31 16:16:20 +01:00
goto do_format_control_sequence_error;
2015-06-18 01:33:21 +01:00
} else if (ch == '`') {
2015-09-21 23:05:36 +01:00
/* next character is kept as code */
has_repeats = TRUE;
2016-07-31 16:16:20 +01:00
fptr += get_utf8(fptr, -1, &repeats);
fptr += get_utf8(fptr, -1, &ch);
2015-06-18 01:33:21 +01:00
} else if (ch >= '0' && ch <= '9') {
2015-09-21 23:05:36 +01:00
has_repeats = TRUE;
repeats = 0;
while (ch >= '0' && ch <= '9') {
2015-11-11 07:50:12 +00:00
repeats = repeats * 10 + (ch - '0');
2016-07-31 16:16:20 +01:00
fptr += get_utf8(fptr, -1, &ch);
2015-09-21 23:05:36 +01:00
}
2015-06-18 01:33:21 +01:00
}
switch (ch) {
2015-11-11 07:50:12 +00:00
case 'a':
/* print an atom */
if (has_repeats || targ > tnum - 1)
2016-07-31 16:16:20 +01:00
goto do_format_control_sequence_error;
2015-11-11 07:50:12 +00:00
t = targs[targ++];
if (IsVarTerm(t))
goto do_instantiation_error;
if (!IsAtomTerm(t))
goto do_type_atom_error;
yhandle_t sl = Yap_StartSlots();
// stream is already locked.
2016-04-05 02:53:39 +01:00
Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f,
GLOBAL_MaxPriority);
2015-11-11 07:50:12 +00:00
Yap_CloseSlots(sl);
break;
case 'c': {
Int nch, i;
if (targ > tnum - 1)
2016-07-31 16:16:20 +01:00
goto do_format_control_sequence_error;
2015-11-11 07:50:12 +00:00
t = targs[targ++];
if (IsVarTerm(t))
goto do_instantiation_error;
if (!IsIntegerTerm(t))
goto do_type_int_error;
nch = IntegerOfTerm(t);
if (nch < 0)
goto do_domain_not_less_zero_error;
if (!has_repeats)
repeats = 1;
for (i = 0; i < repeats; i++)
f_putc(sno, nch);
break;
}
case 'e':
case 'E':
case 'f':
case 'g':
case 'G': {
Float fl;
char *ptr;
2016-08-04 16:24:32 +01:00
char fmt[32];
2015-11-11 07:50:12 +00:00
if (targ > tnum - 1)
2016-07-31 16:16:20 +01:00
goto do_format_control_sequence_error;
2015-11-11 07:50:12 +00:00
t = targs[targ++];
if (IsVarTerm(t))
goto do_instantiation_error;
if (!IsNumTerm(t))
goto do_type_number_error;
if (IsIntegerTerm(t)) {
fl = (Float)IntegerOfTerm(t);
2015-06-18 01:33:21 +01:00
#ifdef HAVE_GMP
2015-11-11 07:50:12 +00:00
} else if (IsBigIntTerm(t)) {
fl = Yap_gmp_to_float(t);
2015-06-18 01:33:21 +01:00
#endif
2015-11-11 07:50:12 +00:00
} else {
fl = FloatOfTerm(t);
}
if (!has_repeats)
repeats = 6;
2016-08-04 16:24:32 +01:00
fmt[0] = '%';
fmt[1] = '.';
ptr = fmt + 2;
2015-06-18 01:33:21 +01:00
#if HAVE_SNPRINTF
2016-08-04 16:24:32 +01:00
snprintf(ptr, 31 - 5, "%d", repeats);
2015-06-18 01:33:21 +01:00
#else
2015-11-11 07:50:12 +00:00
sprintf(ptr, "%d", repeats);
2015-06-18 01:33:21 +01:00
#endif
2015-11-11 07:50:12 +00:00
while (*ptr)
ptr++;
ptr[0] = ch;
ptr[1] = '\0';
{
2016-08-04 16:24:32 +01:00
unsigned char *uptr = (unsigned char *)tmp1;
2015-06-18 01:33:21 +01:00
#if HAVE_SNPRINTF
2016-08-04 16:24:32 +01:00
snprintf(tmp1, repeats + 10, fmt, fl);
2015-06-18 01:33:21 +01:00
#else
2016-08-04 16:24:32 +01:00
sprintf(tmp1, fmt, fl);
2015-06-18 01:33:21 +01:00
#endif
2016-08-04 16:24:32 +01:00
while ((uptr += get_utf8(uptr, -1, &ch)) && ch != 0)
2015-11-11 07:50:12 +00:00
f_putc(sno, ch);
}
break;
case 'd':
case 'D':
/* print a decimal, using weird . stuff */
if (targ > tnum - 1)
2016-07-31 16:16:20 +01:00
goto do_format_control_sequence_error;
2015-11-11 07:50:12 +00:00
t = targs[targ++];
if (IsVarTerm(t))
goto do_instantiation_error;
if (!IsIntegerTerm(t)
2015-06-18 01:33:21 +01:00
#ifdef HAVE_GMP
2015-11-11 07:50:12 +00:00
&& !IsBigIntTerm(t)
2015-06-18 01:33:21 +01:00
#endif
2015-11-11 07:50:12 +00:00
)
goto do_type_int_error;
{
Int siz = 0;
char *ptr = tmp1;
tmpbase = tmp1;
if (IsIntegerTerm(t)) {
Int il = IntegerOfTerm(t);
2015-06-18 01:33:21 +01:00
#if HAVE_SNPRINTF
2015-11-11 07:50:12 +00:00
snprintf(tmp1, 256, "%ld", (long int)il);
2015-06-18 01:33:21 +01:00
#else
2015-11-11 07:50:12 +00:00
sprintf(tmp1, "%ld", (long int)il);
2015-06-18 01:33:21 +01:00
#endif
2015-11-11 07:50:12 +00:00
siz = strlen(tmp1);
if (il < 0)
siz--;
2015-06-18 01:33:21 +01:00
#ifdef HAVE_GMP
2015-11-11 07:50:12 +00:00
} else if (IsBigIntTerm(t) && RepAppl(t)[1] == BIG_INT) {
char *res;
tmpbase = tmp1;
while (
!(res = Yap_gmp_to_string(t, tmpbase, TMP_STRING_SIZE, 10))) {
if (tmpbase == tmp1) {
tmpbase = NULL;
} else {
tmpbase = res;
goto do_type_int_error;
2015-09-21 23:05:36 +01:00
}
2015-11-11 07:50:12 +00:00
}
tmpbase = res;
ptr = tmpbase;
2015-06-18 01:33:21 +01:00
#endif
2015-11-11 07:50:12 +00:00
siz = strlen(tmpbase);
} else {
goto do_type_int_error;
}
if (tmpbase[0] == '-') {
f_putc(sno, (int)'-');
ptr++;
}
if (ch == 'D') {
int first = TRUE;
while (siz > repeats) {
if ((siz - repeats) % 3 == 0 && !first) {
f_putc(sno, (int)',');
}
f_putc(sno, (int)(*ptr++));
first = FALSE;
siz--;
2015-09-21 23:05:36 +01:00
}
2015-11-11 07:50:12 +00:00
} else {
while (siz > repeats) {
f_putc(sno, (int)(*ptr++));
siz--;
2015-09-21 23:05:36 +01:00
}
2015-11-11 07:50:12 +00:00
}
if (repeats) {
if (ptr == tmpbase || ptr[-1] == '-') {
f_putc(sno, (int)'0');
2015-09-21 23:05:36 +01:00
}
2015-11-11 07:50:12 +00:00
f_putc(sno, (int)'.');
while (repeats > siz) {
f_putc(sno, (int)'0');
repeats--;
2015-09-21 23:05:36 +01:00
}
2015-11-11 07:50:12 +00:00
while (repeats) {
f_putc(sno, (int)(*ptr++));
repeats--;
}
}
if (tmpbase != tmp1)
free(tmpbase);
break;
case 'r':
case 'R': {
Int numb, radix;
UInt divfactor = 1, size = 1, i;
wchar_t och;
/* print a decimal, using weird . stuff */
if (targ > tnum - 1)
2016-07-31 16:16:20 +01:00
goto do_format_control_sequence_error;
2015-11-11 07:50:12 +00:00
t = targs[targ++];
if (IsVarTerm(t))
goto do_instantiation_error;
if (!has_repeats)
radix = 8;
else
radix = repeats;
if (radix > 36 || radix < 2)
goto do_domain_error_radix;
2015-06-18 01:33:21 +01:00
#ifdef HAVE_GMP
2015-11-11 07:50:12 +00:00
if (IsBigIntTerm(t) && RepAppl(t)[1] == BIG_INT) {
char *pt, *res;
tmpbase = tmp1;
2016-04-05 02:53:39 +01:00
while (!(
res = Yap_gmp_to_string(t, tmpbase, TMP_STRING_SIZE, radix))) {
2015-11-11 07:50:12 +00:00
if (tmpbase == tmp1) {
tmpbase = NULL;
} else {
2015-09-21 23:05:36 +01:00
tmpbase = res;
goto do_type_int_error;
}
}
2015-11-11 07:50:12 +00:00
tmpbase = res;
pt = tmpbase;
while ((ch = *pt++))
f_putc(sno, ch);
if (tmpbase != tmp1)
free(tmpbase);
break;
}
#endif
if (!IsIntegerTerm(t))
goto do_type_int_error;
numb = IntegerOfTerm(t);
if (numb < 0) {
numb = -numb;
f_putc(sno, (int)'-');
}
while (numb / divfactor >= radix) {
divfactor *= radix;
size++;
}
for (i = 1; i < size; i++) {
Int dig = numb / divfactor;
och = base_dig(dig, ch);
f_putc(sno, och);
numb %= divfactor;
divfactor /= radix;
}
och = base_dig(numb, ch);
f_putc(sno, och);
break;
}
case 's':
if (targ > tnum - 1)
2016-07-31 16:16:20 +01:00
goto do_format_control_sequence_error;
2015-11-11 07:50:12 +00:00
t = targs[targ++];
if (IsVarTerm(t))
goto do_instantiation_error;
if (!format_print_str(sno, repeats, has_repeats, t, f_putc)) {
goto do_default_error;
}
break;
case 'i':
if (targ > tnum - 1 || has_repeats)
2016-07-31 16:16:20 +01:00
goto do_format_control_sequence_error;
2015-11-11 07:50:12 +00:00
targ++;
break;
case 'k':
if (targ > tnum - 1 || has_repeats)
2016-07-31 16:16:20 +01:00
goto do_format_control_sequence_error;
2015-11-11 07:50:12 +00:00
t = targs[targ++];
yhandle_t sl = Yap_StartSlots();
Yap_plwrite(t, GLOBAL_Stream + sno, 0,
2016-04-05 02:53:39 +01:00
Quote_illegal_f | Ignore_ops_f | To_heap_f,
GLOBAL_MaxPriority);
2015-11-11 07:50:12 +00:00
Yap_CloseSlots(sl);
break;
case '@':
t = targs[targ++];
{
2016-07-31 16:16:20 +01:00
yhandle_t sl0 = Yap_StartSlots(), s1 = Yap_PushHandle(ARG1),
sl = Yap_InitSlots(tnum - targ, targs + targ);
2015-11-11 07:50:12 +00:00
Int res;
2016-07-31 16:16:20 +01:00
int os = LOCAL_c_output_stream;
LOCAL_c_output_stream = sno;
res = Yap_execute_goal(t, 0, fmod, true);
LOCAL_c_output_stream = os;
2016-03-29 01:57:55 +01:00
if (Yap_HasException())
2015-11-11 07:50:12 +00:00
goto ex_handler;
2016-05-14 11:30:42 +01:00
if (!res) {
2016-07-31 16:16:20 +01:00
if (!alloc_fstr)
fstr = NULL;
if (mytargs == targs) {
targs = NULL;
}
format_clean_up(sno, sno0, &finfo, fstr, targs);
return false;
2015-09-21 23:05:36 +01:00
}
2016-07-31 16:16:20 +01:00
ARG1 = Yap_GetFromHandle(s1);
Yap_RecoverHandles(sl, tnum - targ);
Yap_CloseSlots(sl0);
2015-11-11 07:50:12 +00:00
}
break;
case 'p':
if (targ > tnum - 1 || has_repeats)
2016-07-31 16:16:20 +01:00
goto do_format_control_sequence_error;
2015-11-11 07:50:12 +00:00
t = targs[targ++];
{
Int sl = Yap_InitSlot(args);
Yap_plwrite(t, GLOBAL_Stream + sno, 0,
2016-04-05 02:53:39 +01:00
Handle_vars_f | Use_portray_f | To_heap_f,
GLOBAL_MaxPriority);
2015-11-11 07:50:12 +00:00
args = Yap_GetFromSlot(sl);
2015-09-21 23:05:36 +01:00
Yap_CloseSlots(sl);
2015-11-11 07:50:12 +00:00
}
2016-03-29 01:57:55 +01:00
if (Yap_HasException()) {
2015-11-11 07:50:12 +00:00
ex_handler:
if (tnum <= 8)
targs = NULL;
if (IsAtomTerm(tail)) {
fstr = NULL;
2015-09-21 23:05:36 +01:00
}
2015-11-11 07:50:12 +00:00
if (GLOBAL_Stream[sno].status & InMemory_Stream_f) {
GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler;
2015-09-21 23:05:36 +01:00
}
2016-07-31 16:16:20 +01:00
if (!alloc_fstr)
fstr = NULL;
if (mytargs == targs) {
targs = NULL;
}
format_clean_up(sno, sno0, &finfo, fstr, targs);
2016-03-29 01:57:55 +01:00
Yap_RaiseException();
return false;
2015-11-11 07:50:12 +00:00
}
break;
case 'q':
if (targ > tnum - 1 || has_repeats)
2016-07-31 16:16:20 +01:00
goto do_format_control_sequence_error;
2015-11-11 07:50:12 +00:00
t = targs[targ++];
yhandle_t sl0 = Yap_StartSlots();
Yap_plwrite(t, GLOBAL_Stream + sno, 0,
2016-04-05 02:53:39 +01:00
Handle_vars_f | Quote_illegal_f | To_heap_f,
GLOBAL_MaxPriority);
2015-11-11 07:50:12 +00:00
Yap_CloseSlots(sl0);
break;
case 'w':
if (targ > tnum - 1 || has_repeats)
2016-07-31 16:16:20 +01:00
goto do_format_control_sequence_error;
2015-11-11 07:50:12 +00:00
t = targs[targ++];
yhandle_t slf = Yap_StartSlots();
Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f,
GLOBAL_MaxPriority);
Yap_CloseSlots(slf);
2016-07-31 16:16:20 +01:00
break;
case 'W':
if (targ > tnum - 2 || has_repeats)
goto do_format_control_sequence_error;
targ -= 2;
{
yhandle_t slf = Yap_StartSlots();
if (!Yap_WriteTerm(sno, targs[1], targs[0] PASS_REGS)) {
Yap_CloseSlots(slf);
goto do_default_error;
};
2016-07-31 16:16:20 +01:00
Yap_CloseSlots(slf);
}
2015-11-11 07:50:12 +00:00
break;
case '~':
if (has_repeats)
2016-07-31 16:16:20 +01:00
goto do_format_control_sequence_error;
2015-11-11 07:50:12 +00:00
f_putc(sno, (int)'~');
break;
2016-07-31 16:16:20 +01:00
case 'n':
2015-11-11 07:50:12 +00:00
if (!has_repeats)
repeats = 1;
while (repeats--) {
f_putc(sno, (int)'\n');
}
2016-09-28 15:08:22 +01:00
sno = format_synch(sno, sno0, &finfo);
2015-11-11 07:50:12 +00:00
break;
case 'N':
if (!has_repeats)
has_repeats = 1;
if (GLOBAL_Stream[sno].linepos != 0) {
2016-07-31 16:16:20 +01:00
f_putc(sno, '\n');
2016-09-28 15:08:22 +01:00
sno = format_synch(sno, sno0, &finfo);
2015-11-11 07:50:12 +00:00
}
if (repeats > 1) {
Int i;
for (i = 1; i < repeats; i++)
2015-09-21 23:05:36 +01:00
f_putc(sno, '\n');
2015-11-11 07:50:12 +00:00
}
2016-09-28 15:08:22 +01:00
sno = format_synch(sno, sno0, &finfo);
2015-11-11 07:50:12 +00:00
break;
/* padding */
case '|':
fill_pads(sno, sno0, repeats, &finfo PASS_REGS);
2015-11-11 07:50:12 +00:00
break;
case '+':
2016-07-31 16:16:20 +01:00
fill_pads(sno, sno0, finfo.lstart + repeats, &finfo PASS_REGS);
2015-11-11 07:50:12 +00:00
break;
case 't': {
#if MAY_WRITE
if (fflush(GLOBAL_Stream[sno].file) == 0) {
2016-07-31 16:16:20 +01:00
finfo.gap[finfo.gapi].phys = ftell(GLOBAL_Stream[sno].file);
2015-11-11 07:50:12 +00:00
}
#else
2016-07-31 16:16:20 +01:00
finfo.gap[finfo.gapi].phys = GLOBAL_Stream[sno].u.mem_string.pos;
#endif
finfo.gap[finfo.gapi].log = GLOBAL_Stream[sno].linepos;
2016-07-31 16:16:20 +01:00
if (has_repeats)
finfo.gap[finfo.gapi].filler = fptr[-2];
2015-11-11 07:50:12 +00:00
else
2016-07-31 16:16:20 +01:00
finfo.gap[finfo.gapi].filler = ' ';
finfo.gapi++;
2016-07-31 16:16:20 +01:00
} break;
2015-11-11 07:50:12 +00:00
do_instantiation_error:
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
goto do_default_error;
do_type_int_error:
LOCAL_Error_TYPE = TYPE_ERROR_INTEGER;
goto do_default_error;
do_type_number_error:
LOCAL_Error_TYPE = TYPE_ERROR_NUMBER;
goto do_default_error;
do_type_atom_error:
LOCAL_Error_TYPE = TYPE_ERROR_ATOM;
goto do_default_error;
do_domain_not_less_zero_error:
LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO;
goto do_default_error;
do_domain_error_radix:
LOCAL_Error_TYPE = DOMAIN_ERROR_RADIX;
goto do_default_error;
2016-07-31 16:16:20 +01:00
do_format_control_sequence_error:
LOCAL_Error_TYPE = DOMAIN_ERROR_FORMAT_CONTROL_SEQUENCE;
2015-11-11 07:50:12 +00:00
default:
2016-07-31 16:16:20 +01:00
LOCAL_Error_TYPE = YAP_NO_ERROR;
2015-11-11 07:50:12 +00:00
do_default_error:
if (tnum <= 8)
targs = NULL;
if (IsAtomTerm(tail)) {
fstr = NULL;
}
{
Term ta[2];
ta[0] = otail;
ta[1] = oargs;
Yap_Error(LOCAL_Error_TYPE,
Yap_MkApplTerm(Yap_MkFunctor(AtomFormat, 2), 2, ta),
2016-07-31 16:16:20 +01:00
"arguments to format");
2015-11-11 07:50:12 +00:00
}
if (GLOBAL_Stream[sno].status & InMemory_Stream_f) {
GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler;
2015-09-21 23:05:36 +01:00
}
2016-07-31 16:16:20 +01:00
if (!alloc_fstr)
fstr = NULL;
if (mytargs == targs) {
targs = NULL;
}
format_clean_up(sno, sno0, &finfo, fstr, targs);
2015-11-11 07:50:12 +00:00
LOCAL_Error_TYPE = YAP_NO_ERROR;
return FALSE;
2015-09-21 23:05:36 +01:00
}
2015-11-11 07:50:12 +00:00
}
/* ok, now we should have a command */
2015-06-18 01:33:21 +01:00
}
} else {
if (ch == '\n') {
2016-09-28 15:08:22 +01:00
sno = format_synch(sno, sno0, &finfo);
}
2015-06-18 01:33:21 +01:00
f_putc(sno, ch);
}
}
2016-07-31 16:16:20 +01:00
// fill_pads( sno, 0, &finfo);
2015-11-11 07:50:12 +00:00
if (IsAtomTerm(tail) || IsStringTerm(tail)) {
2015-06-18 01:33:21 +01:00
fstr = NULL;
}
if (tnum <= 8)
targs = NULL;
if (GLOBAL_Stream[sno].status & InMemory_Stream_f) {
GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler;
}
2016-07-31 16:16:20 +01:00
if (!alloc_fstr)
fstr = NULL;
if (mytargs == targs) {
targs = NULL;
}
format_clean_up(sno, sno0, &finfo, fstr, targs);
2015-06-18 01:33:21 +01:00
return (TRUE);
}
2016-07-31 16:16:20 +01:00
static Term memStreamToTerm(int output_stream, Functor f, Term inp) {
const char *s = Yap_MemExportStreamPtr(output_stream);
encoding_t enc = GLOBAL_Stream[output_stream].encoding;
if (f == FunctorAtom) {
return MkAtomTerm(Yap_LookupAtom(s));
} else if (f == FunctorCodes) {
return Yap_CharsToDiffListOfCodes(s, ArgOfTerm(2, inp), enc PASS_REGS);
} else if (f == FunctorCodes1) {
return Yap_CharsToListOfCodes(s, enc PASS_REGS);
} else if (f == FunctorChars) {
return Yap_CharsToDiffListOfAtoms(s, ArgOfTerm(2, inp), enc PASS_REGS);
} else if (f == FunctorChars1) {
return Yap_CharsToListOfAtoms(s, enc PASS_REGS);
} else if (f == FunctorString1) {
return Yap_CharsToString(s, enc PASS_REGS);
}
Yap_Error(DOMAIN_ERROR_FORMAT_OUTPUT, inp, NULL);
return 0L;
}
2015-11-11 07:50:12 +00:00
/**
2015-11-10 14:18:27 +00:00
* @pred with_output_to(+ _Ouput_,: _Goal_)
Run _Goal_ as once/1, while characters written to the current
output are sent to _Output_. The predicate was introduced by SWI-Prolog.
The example below
defines the DCG rule `term/3` to insert a term in the output:
~~~~~
term(Term, In, Tail) :-
with_output_to(codes(In, Tail), write(Term)).
?- phrase(term(hello), X).
X = [104, 101, 108, 108, 111]
~~~~~
+ A Stream handle or alias
2015-11-11 07:50:12 +00:00
Temporary switch current output to the given stream. Redirection using
with_output_to/2 guarantees the original output is restored, also if Goal fails
or raises an exception. See also call_cleanup/2.
2015-11-10 14:18:27 +00:00
+ atom(- _Atom_)
2015-11-11 07:50:12 +00:00
Create an atom from the emitted characters.
2015-11-10 14:18:27 +00:00
Applications should generally avoid creating atoms by breaking and
concatenating other atoms as the creation of large numbers of
2015-11-11 07:50:12 +00:00
intermediate atoms puts pressure on the atom table and the data-base. This may
lead to collisions in the hash tables used to implement atoms, and may result in
frequent calls to the garbage collector. In multi-threaded applications, access
to the atom table is controlled by locks. This predicate supports creating the
therms by expanding
2015-11-10 14:18:27 +00:00
difference-list.
+ string(- _String_)
Create a string-object, notice that strings are atomic objects.
+ codes(- _Codes_)
2015-11-11 07:50:12 +00:00
Create a list of character codes from the emitted characters, similar to
atom_codes/2.
2015-11-10 14:18:27 +00:00
+ codes(- _Codes_, - _Tail_)
Create a list of character codes as a difference-list.
+ chars(- _Chars_)
2015-11-11 07:50:12 +00:00
Create a list of one-character-atoms codes from the emitted characters, similar
to atom_chars/2.
2015-11-10 14:18:27 +00:00
+ chars(- _Chars_, - _Tail_)
Create a list of one-character-atoms as a difference-list.
2015-07-06 12:03:16 +01:00
*/
2015-11-11 07:50:12 +00:00
static Int with_output_to(USES_REGS1) {
2015-07-06 12:03:16 +01:00
int old_out = LOCAL_c_output_stream;
int output_stream;
Term tin = Deref(ARG1);
Functor f;
bool out;
bool my_mem_stream;
2016-07-31 16:16:20 +01:00
yhandle_t hdl = Yap_PushHandle(tin);
2015-09-21 23:05:36 +01:00
if (IsVarTerm(tin)) {
2015-11-11 07:50:12 +00:00
Yap_Error(INSTANTIATION_ERROR, tin, "with_output_to/3");
2015-09-21 23:05:36 +01:00
return false;
}
2015-11-11 07:50:12 +00:00
if (IsApplTerm(tin) && (f = FunctorOfTerm(tin)) &&
(f == FunctorAtom || f == FunctorString || f == FunctorCodes1 ||
f == FunctorCodes || f == FunctorChars1 || f == FunctorChars)) {
output_stream = Yap_OpenBufWriteStream(PASS_REGS1);
my_mem_stream = true;
2015-07-06 12:03:16 +01:00
} else {
/* needs to change LOCAL_c_output_stream for write */
2015-11-11 07:50:12 +00:00
output_stream = Yap_CheckStream(ARG1, Output_Stream_f, "format/3");
my_mem_stream = false;
f = NIL;
2015-07-06 12:03:16 +01:00
}
if (output_stream == -1) {
return false;
}
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
2015-11-11 07:50:12 +00:00
out = Yap_Execute(Deref(ARG2) PASS_REGS);
2015-07-23 01:33:30 +01:00
LOCK(GLOBAL_Stream[output_stream].streamlock);
2015-07-06 12:03:16 +01:00
LOCAL_c_output_stream = old_out;
if (my_mem_stream) {
2015-07-06 12:03:16 +01:00
Term tat;
2016-07-31 16:16:20 +01:00
Term inp = Yap_GetFromHandle(hdl);
2015-07-06 12:03:16 +01:00
if (out) {
2016-07-31 16:16:20 +01:00
tat = memStreamToTerm(output_stream, f, inp);
2015-11-11 07:50:12 +00:00
out = Yap_unify(tat, ArgOfTerm(1, inp));
2015-07-06 12:03:16 +01:00
}
2016-07-31 16:16:20 +01:00
Yap_CloseStream(output_stream);
2015-07-06 12:03:16 +01:00
}
return out;
}
2016-07-31 16:16:20 +01:00
static Int format(Term tf, Term tas, Term tout USES_REGS) {
2015-06-18 01:33:21 +01:00
Int out;
2016-07-31 16:16:20 +01:00
Functor f;
int output_stream;
bool mem_stream = false;
2015-11-11 07:50:12 +00:00
2015-08-07 22:57:53 +01:00
if (IsVarTerm(tout)) {
2015-11-11 07:50:12 +00:00
Yap_Error(INSTANTIATION_ERROR, tout, "format/3");
2015-06-18 01:33:21 +01:00
return false;
}
2016-07-31 16:16:20 +01:00
yhandle_t hl = Yap_StartHandles(), yo = Yap_PushHandle(tout);
2015-11-11 07:50:12 +00:00
if (IsApplTerm(tout) && (f = FunctorOfTerm(tout)) &&
(f == FunctorAtom || f == FunctorString1 || f == FunctorCodes1 ||
f == FunctorCodes || f == FunctorChars1 || f == FunctorChars)) {
output_stream = Yap_OpenBufWriteStream(PASS_REGS1);
mem_stream = true;
} else {
/* needs to change LOCAL_c_output_stream for write */
output_stream = Yap_CheckStream(tout, Output_Stream_f, "format/3");
}
2015-06-18 01:33:21 +01:00
if (output_stream == -1) {
2015-08-07 22:57:53 +01:00
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
2016-07-31 16:16:20 +01:00
return false;
2015-08-07 22:57:53 +01:00
} else {
2015-11-11 07:50:12 +00:00
out = doformat(tf, tas, output_stream PASS_REGS);
2015-09-21 23:05:36 +01:00
UNLOCK(GLOBAL_Stream[output_stream].streamlock);
2016-07-31 16:16:20 +01:00
if (mem_stream) {
if (out) {
Term to = Yap_GetFromHandle(yo);
Term tat = memStreamToTerm(output_stream, f, to);
if (tat == 0)
return false;
out = Yap_unify(tat, ArgOfTerm(1, to));
2015-06-18 01:33:21 +01:00
}
2016-07-31 16:16:20 +01:00
Yap_CloseStream(output_stream);
2015-06-18 01:33:21 +01:00
}
}
2016-07-31 16:16:20 +01:00
Yap_CloseHandles(hl);
2015-06-18 01:33:21 +01:00
return out;
}
2015-11-10 14:18:27 +00:00
/** @pred format(+ _T_, :ListWithArguments)
*
* Print formatted output to the current output stream.
*/
2015-11-11 07:50:12 +00:00
static Int format2(USES_REGS1) { /* 'format'(Stream,Control,Args) */
2015-06-18 01:33:21 +01:00
Int res;
2015-11-11 07:50:12 +00:00
res = doformat(Deref(ARG1), Deref(ARG2), LOCAL_c_output_stream PASS_REGS);
2015-06-18 01:33:21 +01:00
return res;
}
2015-11-10 14:18:27 +00:00
/** @pred format(+_Stream_+ _T_, :ListWithArguments)
*
* Print formatted output to the stream _Stream_.
*/
2015-11-11 07:50:12 +00:00
static Int format3(USES_REGS1) {
2015-06-18 01:33:21 +01:00
Int res;
2016-07-31 16:16:20 +01:00
res = format(Deref(ARG2), Deref(ARG3), Deref(ARG1) PASS_REGS);
2015-06-18 01:33:21 +01:00
return res;
}
2015-11-11 07:50:12 +00:00
void Yap_InitFormat(void) {
Yap_InitCPred("format", 2, format2, SyncPredFlag);
Yap_InitCPred("format", 3, format3, SyncPredFlag);
Yap_InitCPred("with_output_to", 2, with_output_to, SyncPredFlag);
2015-06-18 01:33:21 +01:00
}
2015-11-10 14:18:27 +00:00
/// @}