/************************************************************************* * * * 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 * * * *************************************************************************/ #ifdef SCCS static char SccsId[] = "%W% %G%"; #endif /** * @defgroup FormattedIO Formatted Output * @ingroup YAPIO * This file includes the definition of the formatted output predicates. * * @{ * * @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. */ #include "Yap.h" #include "YapHeap.h" #include "YapText.h" #include "Yatom.h" #include "yapio.h" #include #if HAVE_UNISTD_H #include #endif #if HAVE_STDARG_H #include #endif #ifdef _WIN32 #if HAVE_IO_H /* Windows */ #include #endif #if HAVE_SOCKET #include #endif #include #ifndef S_ISDIR #define S_ISDIR(x) (((x)&_S_IFDIR) == _S_IFDIR) #endif #endif #include "eval.h" #include "iopreds.h" #define FORMAT_MAX_SIZE 1024 typedef struct { Int filler; /* character to dump */ int phys; /* position in buffer */ int log; /* columnn as wide chsh */ } gap_t; typedef struct format_status { gap_t gap[16]; // number of octets int phys_start; // number of characters int lstart; int gapi; } format_info; static bool format_synch(int sno, int sno0, format_info *fg) { int (*f_putc)(int, int); const char *s; int n; if (sno == sno0) { #if MAY_WRITE fflush(GLOBAL_Stream[sno].file); #endif return true; } f_putc = GLOBAL_Stream[sno0].stream_putc; #if MAY_WRITE if (fflush(GLOBAL_Stream[sno].file) == 0) { s = GLOBAL_Stream[sno].nbuf; n = ftell(GLOBAL_Stream[sno].file); fwrite(s, n, 1, GLOBAL_Stream[sno0].file); rewind(GLOBAL_Stream[sno].file); fflush(GLOBAL_Stream[sno0].file); } else return false; #else s = GLOBAL_Stream[sno].u.mem_string.buf; n = GLOBAL_Stream[sno].u.mem_string.pos; #endif #if MAY_WRITE #else while (n--) { f_putc(sno0, *s++); } GLOBAL_Stream[sno].u.mem_string.pos = 0; #endif GLOBAL_Stream[sno].linecount = 1; GLOBAL_Stream[sno].linepos = 0; GLOBAL_Stream[sno].charcount = 0; fg->lstart = 0; fg->phys_start = 0; fg->gapi = 0; return true; } // uses directly the buffer in the memory stream. static bool fill_pads(int sno, int sno0, int total, format_info *fg USES_REGS) { int nfillers, fill_space, lfill_space, nchars; int (*f_putc)(int, int); const char *buf; int phys_end; f_putc = GLOBAL_Stream[sno0].stream_putc; #if MAY_WRITE if (fflush(GLOBAL_Stream[sno].file) == 0) { buf = GLOBAL_Stream[sno].nbuf; phys_end = ftell(GLOBAL_Stream[sno].file); } else return false; #else buf = GLOBAL_Stream[sno].u.mem_string.buf; phys_end = GLOBAL_Stream[sno].u.mem_string.pos; #endif if (fg->gapi == 0) { fg->gap[0].phys = phys_end; fg->gap[0].filler = ' '; fg->gapi = 1; } nchars = total - GLOBAL_Stream[sno].linepos; if (nchars < 0) nchars = 0; /* ignore */ nfillers = fg->gapi; fill_space = nchars / nfillers; lfill_space = nchars % nfillers; int i = fg->phys_start; gap_t *padi = fg->gap; while (i < phys_end) { if (i == padi->phys) { int j; for (j = 0; j < fill_space; j++) f_putc(sno0, padi->filler); padi++; /* last gap??*/ if (padi - fg->gap == fg->gapi) { for (j = 0; j < fill_space; j++) f_putc(sno0, (padi - 1)->filler); } } f_putc(sno0, buf[i++]); } // final gap if (i == padi->phys) { int j; for (j = 0; j < fill_space + lfill_space; j++) f_putc(sno0, padi->filler); }; #if MAY_WRITE rewind(GLOBAL_Stream[sno].file); fflush(GLOBAL_Stream[sno0].file); #else GLOBAL_Stream[sno].u.mem_string.pos = 0; #endif GLOBAL_Stream[sno].linecount = 1; GLOBAL_Stream[sno].linepos += nchars; GLOBAL_Stream[sno].charcount = 0; fg->phys_start = 0; fg->lstart = GLOBAL_Stream[sno].linepos; fg->gapi = 0; return true; } static int format_print_str(Int sno, Int size, Int has_size, Term args, int (*f_putc)(int, wchar_t)) { Term arghd; if (IsStringTerm(args)) { const unsigned char *pt = UStringOfTerm(args); while (*pt && (!has_size || size > 0)) { utf8proc_int32_t ch; pt += get_utf8(pt, -1, &ch); } } else { 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; } #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(int sno, int sno0, format_info *finf, const unsigned char *fstr, const Term *targs) { if (sno != sno0) { format_synch(sno, sno0, finf); Yap_CloseStream(sno); } if (fstr) { free((void *)fstr); } if (targs) Yap_FreeAtomSpace((void *)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 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 doformat(volatile Term otail, volatile Term oargs, int sno0 USES_REGS) { char tmp1[TMP_STRING_SIZE], *tmpbase; int ch; Term mytargs[8], *targs; Int tnum, targ; const unsigned char *fstr, *fptr; Term args; Term tail; int (*f_putc)(int, wchar_t); int sno = sno0; jmp_buf format_botch; volatile void *old_handler; volatile int old_pos; format_info finfo; Term fmod = CurrentModule; bool alloc_fstr = false; if (GLOBAL_Stream[sno0].status & InMemory_Stream_f) { 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)) { Yap_Error(RESOURCE_ERROR_HEAP, otail, "format/2"); return false; } 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; if (IsVarTerm(tail)) { Yap_Error(INSTANTIATION_ERROR, tail, "format/2"); return (FALSE); } else if ((fptr = Yap_TextToUTF8Buffer(tail))) { fstr = fptr; alloc_fstr = true; } else { Yap_Error(TYPE_ERROR_TEXT, 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; } // it starts here finfo.gapi = 0; finfo.phys_start = 0; finfo.lstart = 0; if (true || !(GLOBAL_Stream[sno].status & InMemory_Stream_f)) sno = Yap_OpenBufWriteStream(PASS_REGS1); if (sno < 0) return false; f_putc = GLOBAL_Stream[sno0].stream_wputc; if (sno == -1) { if (!alloc_fstr) fstr = NULL; if (mytargs == targs) { targs = NULL; } format_clean_up(sno, sno0, &finfo, fstr, targs); return false; } while ((fptr += get_utf8(fptr, -1, &ch)) && ch) { Term t = TermNil; int has_repeats = false; int repeats = 0; if (ch == '~') { /* start command */ fptr += get_utf8(fptr, -1, &ch); if (ch == '*') { fptr += get_utf8(fptr, -1, &ch); has_repeats = TRUE; if (targ > tnum - 1) { goto do_format_control_sequence_error; } repeats = fetch_index_from_args(targs[targ++]); if (repeats == -1) goto do_format_control_sequence_error; } else if (ch == '`') { /* next character is kept as code */ has_repeats = TRUE; fptr += get_utf8(fptr, -1, &repeats); fptr += get_utf8(fptr, -1, &ch); } else if (ch >= '0' && ch <= '9') { has_repeats = TRUE; repeats = 0; while (ch >= '0' && ch <= '9') { repeats = repeats * 10 + (ch - '0'); fptr += get_utf8(fptr, -1, &ch); } } switch (ch) { case 'a': /* print an atom */ if (has_repeats || targ > tnum - 1) goto do_format_control_sequence_error; 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. Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f, GLOBAL_MaxPriority); Yap_CloseSlots(sl); break; case 'c': { Int nch, i; if (targ > tnum - 1) goto do_format_control_sequence_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; char fmt[32]; if (targ > tnum - 1) goto do_format_control_sequence_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 HAVE_GMP } else if (IsBigIntTerm(t)) { fl = Yap_gmp_to_float(t); #endif } else { fl = FloatOfTerm(t); } if (!has_repeats) repeats = 6; fmt[0] = '%'; fmt[1] = '.'; ptr = fmt + 2; #if HAVE_SNPRINTF snprintf(ptr, 31 - 5, "%d", repeats); #else sprintf(ptr, "%d", repeats); #endif while (*ptr) ptr++; ptr[0] = ch; ptr[1] = '\0'; { unsigned char *uptr = (unsigned char *)tmp1; #if HAVE_SNPRINTF snprintf(tmp1, repeats + 10, fmt, fl); #else sprintf(tmp1, fmt, fl); #endif while ((uptr += get_utf8(uptr, -1, &ch)) && ch != 0) f_putc(sno, ch); } break; case 'd': case 'D': /* print a decimal, using weird . stuff */ if (targ > tnum - 1) goto do_format_control_sequence_error; t = targs[targ++]; if (IsVarTerm(t)) goto do_instantiation_error; if (!IsIntegerTerm(t) #ifdef HAVE_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 HAVE_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_format_control_sequence_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 HAVE_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_format_control_sequence_error; 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) goto do_format_control_sequence_error; targ++; break; case 'k': if (targ > tnum - 1 || has_repeats) goto do_format_control_sequence_error; t = targs[targ++]; yhandle_t sl = Yap_StartSlots(); Yap_plwrite(t, GLOBAL_Stream + sno, 0, Quote_illegal_f | Ignore_ops_f | To_heap_f, GLOBAL_MaxPriority); Yap_CloseSlots(sl); break; case '@': t = targs[targ++]; { yhandle_t sl0 = Yap_StartSlots(), s1 = Yap_PushHandle(ARG1), sl = Yap_InitSlots(tnum - targ, targs + targ); Int res; int os = LOCAL_c_output_stream; LOCAL_c_output_stream = sno; res = Yap_execute_goal(t, 0, fmod, true); LOCAL_c_output_stream = os; if (Yap_HasException()) goto ex_handler; if (!res) { if (!alloc_fstr) fstr = NULL; if (mytargs == targs) { targs = NULL; } format_clean_up(sno, sno0, &finfo, fstr, targs); return false; } ARG1 = Yap_GetFromHandle(s1); Yap_RecoverHandles(sl, tnum - targ); Yap_CloseSlots(sl0); } break; case 'p': if (targ > tnum - 1 || has_repeats) goto do_format_control_sequence_error; t = targs[targ++]; { Int sl = Yap_InitSlot(args); Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | Use_portray_f | To_heap_f, GLOBAL_MaxPriority); args = Yap_GetFromSlot(sl); Yap_CloseSlots(sl); } if (Yap_HasException()) { ex_handler: if (tnum <= 8) targs = NULL; if (IsAtomTerm(tail)) { fstr = NULL; } if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler; } if (!alloc_fstr) fstr = NULL; if (mytargs == targs) { targs = NULL; } format_clean_up(sno, sno0, &finfo, fstr, targs); Yap_RaiseException(); return false; } break; case 'q': if (targ > tnum - 1 || has_repeats) goto do_format_control_sequence_error; t = targs[targ++]; yhandle_t sl0 = Yap_StartSlots(); Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | Quote_illegal_f | To_heap_f, GLOBAL_MaxPriority); Yap_CloseSlots(sl0); break; case 'w': if (targ > tnum - 1 || has_repeats) goto do_format_control_sequence_error; 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); 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; }; Yap_CloseSlots(slf); } break; case '~': if (has_repeats) goto do_format_control_sequence_error; f_putc(sno, (int)'~'); break; case 'n': if (!has_repeats) repeats = 1; while (repeats--) { f_putc(sno, (int)'\n'); } format_synch(sno, sno0, &finfo); break; case 'N': if (!has_repeats) has_repeats = 1; if (GLOBAL_Stream[sno].linepos != 0) { f_putc(sno, '\n'); format_synch(sno, sno0, &finfo); } if (repeats > 1) { Int i; for (i = 1; i < repeats; i++) f_putc(sno, '\n'); } format_synch(sno, sno0, &finfo); break; /* padding */ case '|': fill_pads(sno, sno0, repeats, &finfo PASS_REGS); break; case '+': fill_pads(sno, sno0, finfo.lstart + repeats, &finfo PASS_REGS); break; case 't': { #if MAY_WRITE if (fflush(GLOBAL_Stream[sno].file) == 0) { finfo.gap[finfo.gapi].phys = ftell(GLOBAL_Stream[sno].file); } #else finfo.gap[finfo.gapi].phys = GLOBAL_Stream[sno].u.mem_string.pos; #endif finfo.gap[finfo.gapi].log = GLOBAL_Stream[sno].linepos; if (has_repeats) finfo.gap[finfo.gapi].filler = fptr[-2]; else finfo.gap[finfo.gapi].filler = ' '; finfo.gapi++; } break; 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; do_format_control_sequence_error: LOCAL_Error_TYPE = DOMAIN_ERROR_FORMAT_CONTROL_SEQUENCE; default: LOCAL_Error_TYPE = YAP_NO_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(LOCAL_Error_TYPE, Yap_MkApplTerm(Yap_MkFunctor(AtomFormat, 2), 2, ta), "arguments to format"); } if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler; } if (!alloc_fstr) fstr = NULL; if (mytargs == targs) { targs = NULL; } format_clean_up(sno, sno0, &finfo, fstr, targs); LOCAL_Error_TYPE = YAP_NO_ERROR; return FALSE; } } /* ok, now we should have a command */ } } else { if (ch == '\n') { format_synch(sno, sno0, &finfo); } f_putc(sno, ch); } } // fill_pads( sno, 0, &finfo); if (IsAtomTerm(tail) || IsStringTerm(tail)) { 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; } if (!alloc_fstr) fstr = NULL; if (mytargs == targs) { targs = NULL; } format_clean_up(sno, sno0, &finfo, fstr, targs); return (TRUE); } 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; } /** * @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 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. + atom(- _Atom_) Create an atom from the emitted characters. Applications should generally avoid creating atoms by breaking and concatenating other atoms as the creation of large numbers of 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 difference-list. + string(- _String_) Create a string-object, notice that strings are atomic objects. + codes(- _Codes_) Create a list of character codes from the emitted characters, similar to atom_codes/2. + codes(- _Codes_, - _Tail_) Create a list of character codes as a difference-list. + chars(- _Chars_) Create a list of one-character-atoms codes from the emitted characters, similar to atom_chars/2. + chars(- _Chars_, - _Tail_) Create a list of one-character-atoms as a difference-list. */ static Int with_output_to(USES_REGS1) { int old_out = LOCAL_c_output_stream; int output_stream; Term tin = Deref(ARG1); Functor f; bool out; bool my_mem_stream; yhandle_t hdl = Yap_PushHandle(tin); if (IsVarTerm(tin)) { Yap_Error(INSTANTIATION_ERROR, tin, "with_output_to/3"); return false; } 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; } else { /* needs to change LOCAL_c_output_stream for write */ output_stream = Yap_CheckStream(ARG1, Output_Stream_f, "format/3"); my_mem_stream = false; f = NIL; } if (output_stream == -1) { return false; } UNLOCK(GLOBAL_Stream[output_stream].streamlock); out = Yap_Execute(Deref(ARG2) PASS_REGS); LOCK(GLOBAL_Stream[output_stream].streamlock); LOCAL_c_output_stream = old_out; if (my_mem_stream) { Term tat; Term inp = Yap_GetFromHandle(hdl); if (out) { tat = memStreamToTerm(output_stream, f, inp); out = Yap_unify(tat, ArgOfTerm(1, inp)); } Yap_CloseStream(output_stream); } return out; } static Int format(Term tf, Term tas, Term tout USES_REGS) { Int out; Functor f; int output_stream; bool mem_stream = false; if (IsVarTerm(tout)) { Yap_Error(INSTANTIATION_ERROR, tout, "format/3"); return false; } yhandle_t hl = Yap_StartHandles(), yo = Yap_PushHandle(tout); 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"); } if (output_stream == -1) { UNLOCK(GLOBAL_Stream[output_stream].streamlock); return false; } else { out = doformat(tf, tas, output_stream PASS_REGS); UNLOCK(GLOBAL_Stream[output_stream].streamlock); 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)); } Yap_CloseStream(output_stream); } } Yap_CloseHandles(hl); return out; } /** @pred format(+ _T_, :ListWithArguments) * * Print formatted output to the current output stream. */ static Int format2(USES_REGS1) { /* 'format'(Stream,Control,Args) */ Int res; res = doformat(Deref(ARG1), Deref(ARG2), LOCAL_c_output_stream PASS_REGS); return res; } /** @pred format(+_Stream_+ _T_, :ListWithArguments) * * Print formatted output to the stream _Stream_. */ static Int format3(USES_REGS1) { Int res; res = format(Deref(ARG2), Deref(ARG3), Deref(ARG1) PASS_REGS); return res; } 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); } /// @}