add support for with_output_to/2.

C/iopreds.c

@@ -1406,8 +1406,8 @@ ConsoleSocketGetc(int sno)
 static int
 PipeGetc(int sno)
 {
-  register StreamDesc *s = &Stream[sno];
+  StreamDesc *s = &Stream[sno];
-  register Int ch;
+  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) {
+	if (seekable) {
-	  Stream[inp_stream].u.mem_string.pos = cpos;
+	  if (Stream[inp_stream].status & InMemory_Stream_f) {
-	} else {
+	    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;

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
 

pl/modules.yap

@@ -597,6 +597,7 @@ source_module(Mod) :-
 	use_module(?,:,?),
 	when(?,:),
 	with_mutex(+,:),
+	with_output_to(?,:),
 	(: -> :),
 	(: *-> :),
 	(: ; :),

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
+
+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).