diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

eplace format

Browse Source
This commit is contained in:
ubu32
2011-02-14 14:13:45 -08:00
parent 52f8cb1041
commit 4dbdaaa772
12 changed files with 142 additions and 1022 deletions
Download Patch File Download Diff File Expand all files Collapse all files

958
C/iopreds.c
View File

@@ -108,10 +108,8 @@ STATIC_PROTO (Int p_set_read_error_handler, (void));
STATIC_PROTO (Int p_get_read_error_handler, (void));
STATIC_PROTO (Int p_read, (void));
STATIC_PROTO (Int p_past_eof, (void));
STATIC_PROTO (Int p_skip, (void));
STATIC_PROTO (Int p_write_depth, (void));
STATIC_PROTO (Int p_user_file_name, (void));
STATIC_PROTO (Int p_format, (void));
STATIC_PROTO (Int p_startline, (void));
STATIC_PROTO (Int p_change_type_of_char, (void));
STATIC_PROTO (Int p_type_of_char, (void));
@@ -2317,955 +2315,6 @@ p_get0_line_codes (void)
return Yap_unify(out,ARG2);
}
#define FORMAT_MAX_SIZE 256
typedef struct {
Int pos; /* tab point */
char pad; /* ok, it's not standard english */
} pads;
typedef struct format_status {
int format_error;
char *format_ptr, *format_base, *format_max;
int format_buf_size;
pads pad_entries[16], *pad_max;
} format_info;
static int
format_putc(int sno, wchar_t ch) {
if (FormatInfo->format_buf_size == -1)
return EOF;
if (ch == 10) {
char *ptr = FormatInfo->format_base;
#if MAC || _MSC_VER
ch = '\n';
#endif
for (ptr = FormatInfo->format_base; ptr < FormatInfo->format_ptr; ptr++) {
Stream[sno].stream_putc(sno, *ptr);
}
/* reset line */
FormatInfo->format_ptr = FormatInfo->format_base;
FormatInfo->pad_max = FormatInfo->pad_entries;
Stream[sno].stream_putc(sno, '\n');
return((int)10);
} else {
*FormatInfo->format_ptr++ = (char)ch;
if (FormatInfo->format_ptr == FormatInfo->format_max) {
/* oops, we have reached an overflow */
Int new_max_size = FormatInfo->format_buf_size + FORMAT_MAX_SIZE;
char *newbuf;
if ((newbuf = Yap_AllocAtomSpace(new_max_size*sizeof(char))) == NULL) {
FormatInfo->format_buf_size = -1;
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow heap for format/2");
return(EOF);
}
#if HAVE_MEMMOVE
memmove((void *)newbuf, (void *)FormatInfo->format_base, (size_t)((FormatInfo->format_ptr-FormatInfo->format_base)*sizeof(char)));
#else
{
Int n = FormatInfo->format_ptr-FormatInfo->format_base;
char *to = newbuf;
char *from = FormatInfo->format_base;
while (n-- >= 0) {
*to++ = *from++;
}
}
#endif
Yap_FreeAtomSpace(FormatInfo->format_base);
FormatInfo->format_ptr = newbuf+(FormatInfo->format_ptr-FormatInfo->format_base);
FormatInfo->format_base = newbuf;
FormatInfo->format_max = newbuf+new_max_size;
FormatInfo->format_buf_size = new_max_size;
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap at format");
}
}
}
}
return ((int) ch);
}
static void fill_pads(int nchars)
{
int nfillers, fill_space, lfill_space;
if (nchars <= 0) return; /* ignore */
nfillers = FormatInfo->pad_max-FormatInfo->pad_entries;
if (nfillers == 0) {
/* OK, just pad with spaces */
while (nchars--) {
*FormatInfo->format_ptr++ = ' ';
}
return;
}
fill_space = nchars/nfillers;
lfill_space = nchars%nfillers;
if (fill_space) {
pads *padi = FormatInfo->pad_max;
while (padi > FormatInfo->pad_entries) {
char *start_pos;
int n, i;
padi--;
start_pos = FormatInfo->format_base+padi->pos;
n = FormatInfo->format_ptr-start_pos;
#if HAVE_MEMMOVE
memmove((void *)(start_pos+fill_space), (void *)start_pos, (size_t)(n*sizeof(char)));
#else
{
char *to = start_pos+(fill_space+n);
char *from = FormatInfo->format_ptr;
while (n-- > 0) {
*--to = *--from;
}
}
#endif
FormatInfo->format_ptr += fill_space;
for (i = 0; i < fill_space; i++) {
*start_pos++ = padi->pad;
}
}
}
while (lfill_space--) {
*FormatInfo->format_ptr++ = FormatInfo->pad_max[-1].pad;
}
}
static int
format_print_str (Int sno, Int size, Int has_size, Term args, int (* f_putc)(int, wchar_t))
{
Term arghd;
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--;
}
return TRUE;
}
typedef enum {
fst_ok,
fst_error,
fst_too_long
} format_cp_res;
static format_cp_res
copy_format_string(Term inp, char *out, int max)
{
int i = 0;
while (inp != TermNil) {
Term hd;
int ch;
if (IsVarTerm(inp)) {
Yap_Error(INSTANTIATION_ERROR,inp,"format/2");
return fst_error;
}
if (!IsPairTerm(inp)) {
Yap_Error(TYPE_ERROR_LIST,inp,"format/2");
return fst_error;
}
hd = HeadOfTerm(inp);
if (IsVarTerm(hd)) {
Yap_Error(INSTANTIATION_ERROR,hd,"format/2");
return fst_error;
}
if (!IsIntTerm(hd)) {
Yap_Error(TYPE_ERROR_INTEGER,hd,"format/2");
return fst_error;
}
ch = IntOfTerm(hd);
if (ch < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,hd,"format/2");
return fst_error;
}
if (i+1 == max) {
return fst_too_long;
}
/* we've got a character */
out[i++] = ch;
/* done */
inp = TailOfTerm(inp);
}
out[i] = '\0';
return fst_ok;
}
#define FORMAT_COPY_ARGS_ERROR -1
#define FORMAT_COPY_ARGS_OVERFLOW -2
static Int
format_copy_args(Term args, Term *targs, Int tsz)
{
Int n = 0;
while (args != TermNil) {
if (IsVarTerm(args)) {
Yap_Error(INSTANTIATION_ERROR,args,"format/2");
return FORMAT_COPY_ARGS_ERROR;
}
if (!IsPairTerm(args)) {
Yap_Error(TYPE_ERROR_LIST,args,"format/2");
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
format_clean_up(char *format_base, char *fstr, Term *targs)
{
if (format_base)
Yap_FreeAtomSpace(format_base);
if (fstr)
Yap_FreeAtomSpace(fstr);
if (targs)
Yap_FreeAtomSpace((char *)targs);
}
static Int
fetch_index_from_args(Term t)
{
Int i;
if (IsVarTerm(t))
return -1;
if (!IsIntegerTerm(t))
return -1;
i = IntegerOfTerm(t);
if (i < 0)
return -1;
return i;
}
static int
format_has_tabs(const char *seq)
{
int ch;
while ((ch = *seq++)) {
if (ch == '~') {
ch = *seq++;
if (ch == 'p' || ch == '@') {
return TRUE;
}
if (ch == '*') {
ch = *seq++;
} else {
while (ch >= '0' && ch <= '9') ch = *seq++;
}
if (ch == 't' || ch == '|' || ch == '+') {
return TRUE;
}
if (!ch)
return FALSE;
}
}
return FALSE;
}
static wchar_t
base_dig(Int dig, Int ch)
{
if (dig < 10)
return dig+'0';
else if (ch == 'r')
return (dig-10)+'a';
else /* ch == 'R' */
return (dig-10)+'A';
}
#define TMP_STRING_SIZE 1024
static Int
format(volatile Term otail, volatile Term oargs, int sno)
{
char tmp1[TMP_STRING_SIZE], *tmpbase;
int ch;
int column_boundary;
Term mytargs[8], *targs;
Int tnum, targ;
char *fstr = NULL, *fptr;
Term args;
Term tail;
int (* f_putc)(int, wchar_t);
int has_tabs;
volatile void *old_handler;
format_info finfo;
Term fmod = CurrentModule;
FormatInfo = &finfo;
finfo.pad_max = finfo.pad_entries;
finfo.format_error = FALSE;
old_handler = NULL;
args = oargs;
tail = otail;
targ = 0;
column_boundary = 0;
if (IsVarTerm(tail)) {
Yap_Error(INSTANTIATION_ERROR,tail,"format/2");
return(FALSE);
} else if (IsPairTerm (tail)) {
int sz = 256;
do {
format_cp_res fr;
fstr = fptr = Yap_AllocAtomSpace(sz*sizeof(char));
if ((fr = copy_format_string(tail, fstr, sz)) == fst_ok)
break;
if (fr == fst_error) return FALSE;
sz += 256;
Yap_FreeCodeSpace(fstr);
} while (TRUE);
} else if (IsAtomTerm(tail)) {
fstr = fptr = RepAtom(AtomOfTerm(tail))->StrOfAE;
} else {
Yap_Error(CONSISTENCY_ERROR, tail, "format/2");
return FALSE;
}
if (IsVarTerm(args)) {
Yap_Error(INSTANTIATION_ERROR, args, "format/2");
return FALSE;
}
while (IsApplTerm(args) && FunctorOfTerm(args) == FunctorModule) {
fmod = ArgOfTerm(1,args);
args = ArgOfTerm(2,args);
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;
}
}
if (IsPairTerm(args)) {
Int tsz = 8;
targs = mytargs;
do {
tnum = format_copy_args(args, targs, tsz);
if (tnum == FORMAT_COPY_ARGS_ERROR)
return FALSE;
else if (tnum == FORMAT_COPY_ARGS_OVERFLOW) {
if (mytargs != targs) {
Yap_FreeCodeSpace((char *)targs);
}
tsz += 16;
targs = (Term *)Yap_AllocAtomSpace(tsz*sizeof(Term));
} else {
break;
}
} while (TRUE);
} else if (args != TermNil) {
tnum = 1;
mytargs[0] = args;
targs = mytargs;
} else {
tnum = 0;
targs = mytargs;
}
finfo.format_error = FALSE;
if ((has_tabs = format_has_tabs(fptr))) {
finfo.format_base = finfo.format_ptr = Yap_AllocAtomSpace(FORMAT_MAX_SIZE*sizeof(char));
finfo.format_max = finfo.format_base+FORMAT_MAX_SIZE;
if (finfo.format_ptr == NULL) {
Yap_Error(INSTANTIATION_ERROR,tail,"format/2");
return(FALSE);
}
finfo.format_buf_size = FORMAT_MAX_SIZE;
f_putc = format_putc;
} else {
f_putc = Stream[sno].stream_wputc;
finfo.format_base = NULL;
}
while ((ch = *fptr++)) {
Term t = TermNil;
int has_repeats = FALSE;
int repeats = 0;
if (ch == '~') {
/* start command */
ch = *fptr++;
if (ch == '*') {
ch = *fptr++;
has_repeats = TRUE;
if (targ > tnum-1) {
goto do_consistency_error;
}
repeats = fetch_index_from_args(targs[targ++]);
if (repeats == -1)
goto do_consistency_error;
} else if (ch == '`') {
/* next character is kept as code */
has_repeats = TRUE;
repeats = *fptr++;
ch = *fptr++;
} else if (ch >= '0' && ch <= '9') {
has_repeats = TRUE;
repeats = 0;
while (ch >= '0' && ch <= '9') {
repeats = repeats*10+(ch-'0');
ch = *fptr++;
}
}
switch (ch) {
case 'a':
/* print an atom */
if (has_repeats || targ > tnum-1)
goto do_consistency_error;
t = targs[targ++];
if (IsVarTerm(t))
goto do_instantiation_error;
if (!IsAtomTerm(t))
goto do_type_atom_error;
Yap_StartSlots();
Yap_plwrite (t, f_putc, Handle_vars_f|To_heap_f, 1200);
Yap_CloseSlots();
FormatInfo = &finfo;
break;
case 'c':
{
Int nch, i;
if (targ > tnum-1)
goto do_consistency_error;
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;
if (targ > tnum-1)
goto do_consistency_error;
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);
#ifdef USE_GMP
} else if (IsBigIntTerm(t)) {
fl = Yap_gmp_to_float(t);
#endif
} else {
fl = FloatOfTerm(t);
}
if (!has_repeats)
repeats = 6;
tmp1[0] = '%';
tmp1[1] = '.';
ptr = tmp1+2;
#if HAVE_SNPRINTF
snprintf(ptr,256-5,"%d",repeats);
#else
sprintf(ptr,"%d",repeats);
#endif
while (*ptr) ptr++;
ptr[0] = ch;
ptr[1] = '\0';
{
char *tmp2;
if (!(tmp2 = Yap_AllocCodeSpace(repeats+10)))
goto do_type_int_error;
#if HAVE_SNPRINTF
snprintf (tmp2, repeats+10, tmp1, fl);
#else
sprintf (tmp2, tmp1, fl);
#endif
ptr = tmp2;
while ((ch = *ptr++) != 0)
f_putc(sno, ch);
Yap_FreeCodeSpace(tmp2);
}
break;
case 'd':
case 'D':
/* print a decimal, using weird . stuff */
if (targ > tnum-1)
goto do_consistency_error;
t = targs[targ++];
if (IsVarTerm(t))
goto do_instantiation_error;
if (!IsIntegerTerm(t)
#ifdef USE_GMP
&& !IsBigIntTerm(t)
#endif
)
goto do_type_int_error;
{
Int siz = 0;
char *ptr = tmp1;
tmpbase = tmp1;
if (IsIntegerTerm(t)) {
Int il = IntegerOfTerm(t);
#if HAVE_SNPRINTF
snprintf(tmp1, 256, "%ld", (long int)il);
#else
sprintf(tmp1, "%ld", (long int)il);
#endif
siz = strlen(tmp1);
if (il < 0) siz--;
#ifdef USE_GMP
} 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;
}
}
tmpbase = res;
ptr = tmpbase;
#endif
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--;
}
} else {
while (siz > repeats) {
f_putc(sno, (int) (*ptr++));
siz--;
}
}
if (repeats) {
if (ptr == tmpbase ||
ptr[-1] == '-') {
f_putc(sno, (int) '0');
}
f_putc(sno, (int) '.');
while (repeats > siz) {
f_putc(sno, (int) '0');
repeats--;
}
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)
goto do_consistency_error;
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;
#ifdef USE_GMP
if (IsBigIntTerm(t) && RepAppl(t)[1] == BIG_INT) {
char *pt, *res;
tmpbase = tmp1;
while (!(res = Yap_gmp_to_string(t, tmpbase, TMP_STRING_SIZE, radix))) {
if (tmpbase == tmp1) {
tmpbase = NULL;
} else {
tmpbase = res;
goto do_type_int_error;
}
}
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)
goto do_consistency_error;
t = targs[targ++];
if (!format_print_str (sno, repeats, has_repeats, t, f_putc)) {
goto do_default_error;
}
break;
case 'i':
if (targ > tnum-1 || has_repeats)
goto do_consistency_error;
targ++;
break;
case 'k':
if (targ > tnum-1 || has_repeats)
goto do_consistency_error;
t = targs[targ++];
Yap_StartSlots();
Yap_plwrite (t, f_putc, Quote_illegal_f|Ignore_ops_f|To_heap_f , 1200);
Yap_CloseSlots();
FormatInfo = &finfo;
break;
case '@':
t = targs[targ++];
Yap_StartSlots();
{
Int sl = Yap_InitSlot(args);
Int sl2;
Int res;
Term ta[2];
Term ts;
ta[0] = fmod;
ta[1] = t;
ta[0] = Yap_MkApplTerm(FunctorModule, 2, ta);
ta[1] = MkVarTerm();
sl2 = Yap_InitSlot(ta[1]);
ts = Yap_MkApplTerm(FunctorGFormatAt, 2, ta);
res = Yap_execute_goal(ts, 0, CurrentModule);
FormatInfo = &finfo;
args = Yap_GetFromSlot(sl);
if (EX) goto ex_handler;
if (!res) return FALSE;
ts = Yap_GetFromSlot(sl2);
Yap_RecoverSlots(2);
if (!format_print_str (sno, repeats, has_repeats, ts, f_putc)) {
goto do_default_error;
}
}
Yap_CloseSlots();
break;
case 'p':
if (targ > tnum-1 || has_repeats)
goto do_consistency_error;
t = targs[targ++];
Yap_StartSlots();
{
Int sl = Yap_InitSlot(args);
Yap_plwrite(t, f_putc, Handle_vars_f|Use_portray_f|To_heap_f, 1200);
FormatInfo = &finfo;
args = Yap_GetFromSlot(sl);
Yap_RecoverSlots(1);
}
Yap_CloseSlots();
if (EX != 0L) {
Term ball;
ex_handler:
ball = Yap_PopTermFromDB(EX);
EX = NULL;
if (tnum <= 8)
targs = NULL;
if (IsAtomTerm(tail)) {
fstr = NULL;
}
format_clean_up(finfo.format_base, fstr, targs);
Yap_JumpToEnv(ball);
return FALSE;
}
break;
case 'q':
if (targ > tnum-1 || has_repeats)
goto do_consistency_error;
t = targs[targ++];
Yap_StartSlots();
Yap_plwrite (t, f_putc, Handle_vars_f|Quote_illegal_f|To_heap_f, 1200);
Yap_CloseSlots();
FormatInfo = &finfo;
break;
case 'w':
if (targ > tnum-1 || has_repeats)
goto do_consistency_error;
t = targs[targ++];
Yap_StartSlots();
Yap_plwrite (t, f_putc, Handle_vars_f|To_heap_f, 1200);
Yap_CloseSlots();
FormatInfo = &finfo;
break;
case '~':
if (has_repeats)
goto do_consistency_error;
f_putc(sno, (int) '~');
break;
case 'n':
if (!has_repeats)
repeats = 1;
while (repeats--) {
f_putc(sno, (int) '\n');
}
column_boundary = 0;
finfo.pad_max = finfo.pad_entries;
break;
case 'N':
if (!has_repeats)
has_repeats = 1;
if (Stream[sno].linepos != 0) {
f_putc(sno, (int) '\n');
column_boundary = 0;
finfo.pad_max = finfo.pad_entries;
}
if (repeats > 1) {
Int i;
for (i = 1; i < repeats; i++)
f_putc(sno, (int) '\n');
column_boundary = 0;
finfo.pad_max = finfo.pad_entries;
}
break;
/* padding */
case '|':
if (has_repeats) {
fill_pads(repeats-(finfo.format_ptr-finfo.format_base));
}
finfo.pad_max = finfo.pad_entries;
if (repeats)
column_boundary = repeats;
else
column_boundary = finfo.format_ptr-finfo.format_base;
break;
case '+':
if (has_repeats) {
fill_pads((repeats+column_boundary)-(finfo.format_ptr-finfo.format_base));
} else {
repeats = 8;
fill_pads(8);
}
finfo.pad_max = finfo.pad_entries;
column_boundary = repeats+column_boundary;
break;
case 't':
if (!has_repeats)
finfo.pad_max->pad = ' ';
else
finfo.pad_max->pad = fptr[-2];
finfo.pad_max->pos = finfo.format_ptr-finfo.format_base;
finfo.pad_max++;
f_putc = format_putc;
break;
do_instantiation_error:
Yap_Error_TYPE = INSTANTIATION_ERROR;
goto do_default_error;
do_type_int_error:
Yap_Error_TYPE = TYPE_ERROR_INTEGER;
goto do_default_error;
do_type_number_error:
Yap_Error_TYPE = TYPE_ERROR_NUMBER;
goto do_default_error;
do_type_atom_error:
Yap_Error_TYPE = TYPE_ERROR_ATOM;
goto do_default_error;
do_domain_not_less_zero_error:
Yap_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO;
goto do_default_error;
do_domain_error_radix:
Yap_Error_TYPE = DOMAIN_ERROR_RADIX;
goto do_default_error;
do_consistency_error:
default:
Yap_Error_TYPE = CONSISTENCY_ERROR;
do_default_error:
if (tnum <= 8)
targs = NULL;
if (IsAtomTerm(tail)) {
fstr = NULL;
}
{
Term ta[2];
ta[0] = otail;
ta[1] = oargs;
Yap_Error(Yap_Error_TYPE, Yap_MkApplTerm(Yap_MkFunctor(AtomFormat,2),2,ta), "format/2");
}
format_clean_up(finfo.format_base, fstr, targs);
Yap_Error_TYPE = YAP_NO_ERROR;
return FALSE;
}
}
/* ok, now we should have a command */
}
} else {
f_putc(sno, ch);
}
}
if (has_tabs) {
for (fptr = finfo.format_base; fptr < finfo.format_ptr; fptr++) {
Stream[sno].stream_putc(sno, *fptr);
}
}
if (IsAtomTerm(tail)) {
fstr = NULL;
}
if (tnum <= 8)
targs = NULL;
format_clean_up(finfo.format_base, fstr, targs);
return (TRUE);
}
static Int
p_format(void)
{ /* 'format'(Control,Args) */
Int res;
res = format(Deref(ARG1),Deref(ARG2), Yap_c_output_stream);
return res;
}
static Int
format2(UInt stream_flag)
{
int old_c_stream = Yap_c_output_stream;
Int out;
Term tin = Deref(ARG1);
if (IsVarTerm(tin)) {
Yap_Error(INSTANTIATION_ERROR,tin,"format/3");
return FALSE;
}
/* needs to change Yap_c_output_stream for write */
Yap_c_output_stream = CheckStream (ARG1, Output_Stream_f|stream_flag, "format/3");
UNLOCK(Stream[Yap_c_output_stream].streamlock);
if (Yap_c_output_stream == -1) {
Yap_c_output_stream = old_c_stream;
return FALSE;
}
out = format(Deref(ARG2),Deref(ARG3),Yap_c_output_stream);
{
Yap_c_output_stream = old_c_stream;
}
return out;
}
static Int
p_format2(void)
{ /* 'format'(Stream,Control,Args) */
return format2(0);
}
static Int
p_swi_format(void)
{ /* 'format'(Stream,Control,Args) */
return format2(SWI_Stream_f);
}
static Int
p_skip (void)
{ /* '$skip'(Stream,N) */
int sno = CheckStream (ARG1, Input_Stream_f, "skip/2");
Int n = IntOfTerm (Deref (ARG2));
int ch;
if (sno < 0)
return (FALSE);
if (n < 0 || n > 127) {
UNLOCK(Stream[sno].streamlock);
return (FALSE);
}
UNLOCK(Stream[sno].streamlock);
while ((ch = Stream[sno].stream_wgetc(sno)) != n && ch != -1);
return (TRUE);
}
void Yap_FlushStreams(void)
{
}
@@ -3822,9 +2871,6 @@ Yap_InitIOPreds(void)
Yap_InitCPred ("$get_read_error_handler", 1, p_get_read_error_handler, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$read", 6, p_read, SyncPredFlag|HiddenPredFlag|UserCPredFlag);
Yap_InitCPred ("$read", 7, p_read2, SyncPredFlag|HiddenPredFlag|UserCPredFlag);
Yap_InitCPred ("$skip", 2, p_skip, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("format", 2, p_format, SyncPredFlag);
Yap_InitCPred ("format", 3, p_format2, SyncPredFlag);
Yap_InitCPred ("$start_line", 1, p_startline, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("$user_file_name", 2, p_user_file_name, SafePredFlag|SyncPredFlag),
Yap_InitCPred ("$past_eof", 1, p_past_eof, SafePredFlag|SyncPredFlag),
@@ -3852,10 +2898,6 @@ Yap_InitIOPreds(void)
Yap_InitCPred ("$toupper", 2, p_toupper, SafePredFlag|HiddenPredFlag);
Yap_InitCPred ("$tolower", 2, p_tolower, SafePredFlag|HiddenPredFlag);
CurrentModule = SYSTEM_MODULE;
Yap_InitCPred ("swi_format", 3, p_swi_format, SyncPredFlag);
CurrentModule = cm;
Yap_InitReadUtil ();
InitPlIO ();
#if HAVE_LIBREADLINE && HAVE_READLINE_READLINE_H