From 5b1a2067f94507980ee9810139c6d860d4b51d71 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 14 Apr 2010 10:57:00 +0100 Subject: [PATCH] add support for with_output_to/2. --- C/iopreds.c | 22 +++++++++++------- docs/yap.tex | 42 ++++++++++++++++++++++++++++++++++- pl/modules.yap | 1 + pl/yio.yap | 60 ++++++++++++++++++++++++++++++++++++++++++++++++-- 4 files changed, 114 insertions(+), 11 deletions(-) diff --git a/C/iopreds.c b/C/iopreds.c index bb631fe9a..cc5fd51c8 100755 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -1406,8 +1406,8 @@ ConsoleSocketGetc(int sno) static int PipeGetc(int sno) { - register StreamDesc *s = &Stream[sno]; - register Int ch; + StreamDesc *s = &Stream[sno]; + Int ch; char c; /* should be able to use a buffer */ @@ -1426,7 +1426,11 @@ PipeGetc(int sno) } else if (count > 0) { ch = c; } else { - Yap_Error(SYSTEM_ERROR, TermNil, "read"); +#if HAVE_STRERROR + Yap_Error(SYSTEM_ERROR, TermNil, "at pipe getc: %s", strerror(errno)); +#else + Yap_Error(SYSTEM_ERROR, TermNil, "at pipe getc"); +#endif return post_process_eof(s); } return post_process_read_char(ch, s); @@ -4010,14 +4014,16 @@ static Int Stream[inp_stream].stream_getc = PlUnGetc; Stream[inp_stream].och = ungetc_oldc; } - if (Stream[inp_stream].status & InMemory_Stream_f) { - Stream[inp_stream].u.mem_string.pos = cpos; - } else { + if (seekable) { + if (Stream[inp_stream].status & InMemory_Stream_f) { + Stream[inp_stream].u.mem_string.pos = cpos; + } else if (Stream[inp_stream].status) { #if HAVE_FGETPOS - fsetpos(Stream[inp_stream].u.file.file, &rpos); + fsetpos(Stream[inp_stream].u.file.file, &rpos); #else - fseek(Stream[inp_stream].u.file.file, cpos, 0L); + fseek(Stream[inp_stream].u.file.file, cpos, 0L); #endif + } } if (Yap_Error_TYPE == OUT_OF_TRAIL_ERROR) { Yap_Error_TYPE = YAP_NO_ERROR; diff --git a/docs/yap.tex b/docs/yap.tex index f20f5653b..90a48d4ba 100644 --- a/docs/yap.tex +++ b/docs/yap.tex @@ -1,4 +1,4 @@ -a\input texinfo @c -*- mode: texinfo; coding: latin-1; -*- +Ža\input texinfo @c -*- mode: texinfo; coding: latin-1; -*- @c %**start of header @setfilename yap.info @@ -4995,6 +4995,46 @@ Print formatted output to the current output stream. @cnindex format/3 Print formatted output to stream @var{S}. +@item with_output_to(+@var{Ouput},:@var{Goal}) +@findex with_output_to/2 +@saindex with_output_to/2 +@cnindex with_output_to/2 +Run @var{Goal} as @code{once/1}, while characters written to the current +output are sent to @var{Output}. The predicate is SWI-Prolog +specific. + +Applications should generally avoid creating atoms by breaking and +concatenating other atoms as the creation of large numbers of +intermediate atoms generally leads to poor performance, even more so in +multi-threaded applications. This predicate supports creating +difference-lists from character data efficiently. The example below +defines the DCG rule @code{term/3} to insert a term in the output: + +@example + term(Term, In, Tail) :- + with_output_to(codes(In, Tail), write(Term)). + +?- phrase(term(hello), X). + +X = [104, 101, 108, 108, 111] +@end example + +@table @code +@item 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. +@item atom(-@var{Atom}) + Create an atom from the emitted characters. Please note the remark above. +@item string(-@var{String}) + Create a string-object (not supported in YAP). +@item codes(-@var{Codes}) + Create a list of character codes from the emitted characters, similar to atom_codes/2. +@item codes(-@var{Codes}, -@var{Tail}) + Create a list of character codes as a difference-list. +@item chars(-@var{Chars}) + Create a list of one-character-atoms codes from the emitted characters, similar to atom_chars/2. +@item chars(-@var{Chars}, -@var{Tail}) + Create a list of one-character-atoms as a difference-list. +@end table @end table diff --git a/pl/modules.yap b/pl/modules.yap index 8d4860b91..3ab4bc53b 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -597,6 +597,7 @@ source_module(Mod) :- use_module(?,:,?), when(?,:), with_mutex(+,:), + with_output_to(?,:), (: -> :), (: *-> :), (: ; :), diff --git a/pl/yio.yap b/pl/yio.yap index aab5382cb..65d4069e5 100644 --- a/pl/yio.yap +++ b/pl/yio.yap @@ -1061,7 +1061,7 @@ current_stream(File, Opts, Stream) :- '$extend_file_search_path'(P) :- atom_codes(P,S), '$env_separator'(ES), - '$split_for_path'(S,0'=,ES,Paths), + '$split_for_path'(S,0'=,ES,Paths), %' '$add_file_search_paths'(Paths). '$split_for_path'([], _, _, []). @@ -1152,4 +1152,60 @@ prolog_file_name(File, PrologFileName) :- prolog_file_name(File, PrologFileName) :- '$do_error'(type_error(atom,T), prolog_file_name(File, PrologFileName)). -s \ No newline at end of file + +with_output_to(Output, Command) :- + setup_call_cleanup( '$setup_wot'(Output, Stream, OldStream, with_output_to(Output, Command)), + once(Command), + '$cleanup_wot'(Output, Stream, OldStream) ). + +'$setup_wot'(Output, Stream, OldStream, Goal) :- + '$setup_wot'(Output, Stream, Goal), + current_output(OldStream), + set_output(Stream). + +'$setup_wot'(Output, Stream, Goal) :- + var(Output), !, + '$do_error'(instantiation_error,Goal). +'$setup_wot'(atom(_Atom), Stream, _) :- !, + charsio:open_mem_write_stream(Stream). +'$setup_wot'(codes(_Codes), Stream, _) :- !, + charsio:open_mem_write_stream(Stream). +'$setup_wot'(codes(_Codes, _Tail), Stream, _) :- !, + charsio:open_mem_write_stream(Stream). +'$setup_wot'(chars(_Chars), Stream, _) :- !, + charsio:open_mem_write_stream(Stream). +'$setup_wot'(chars(_Chars, _Tail), Stream, _) :- !, + charsio:open_mem_write_stream(Stream). +'$setup_wot'(Stream, Stream, _) :- + '$stream'(Stream), !. +'$setup_wot'(Output, _, Goal) :- + '$do_error'(type_error(output,Output),Goal). + +'$cleanup_wot'(Output, Stream, OldStream) :- !, + '$cleanup_wot'(Output, Stream), + set_output(OldStream). + +'$cleanup_wot'(atom(Atom), Stream) :- !, + charsio:peek_mem_write_stream(Stream, [], String), + atom_codes(Atom, String), + close(Stream). +'$cleanup_wot'(codes(Codes), Stream) :- !, + charsio:peek_mem_write_stream(Stream, [], Codes), + close(Stream). +'$cleanup_wot'(codes(Codes, Tail), Stream) :- !, + charsio:peek_mem_write_stream(Stream, Tail, Codes), + close(Stream). +'$cleanup_wot'(chars(Chars), Stream) :- !, + charsio:peek_mem_write_stream(Stream, [], String), + '$codes_to_chars'([], String, Chars), + close(Stream). +'$cleanup_wot'(chars(Chars, Tail), Stream) :- !, + charsio:peek_mem_write_stream(Stream, Tail, String), + '$codes_to_chars'(Tail, String, Chars), + close(Stream). +'$cleanup_wot'(_, _). + +'$codes_to_chars'(String0, String, String0) :- String0 == String, !. +'$codes_to_chars'(String0, [Code|String], [Char|Chars]) :- + atom_codes(Char, [Code]), + '$codes_to_chars'(String0, String, Chars). \ No newline at end of file