Merge pull request #1078 from triska/pio_improvements

Various improvements for pure output

src/lib/builtins.pl

@@ -1429,7 +1429,10 @@ parse_stream_options(Options, OptionValues, Stub) :-
 
 
 parse_stream_options_(type(Type), type-Type) :-
-    (  nonvar(Type), lists:member(Type, [text, binary]), !, true
+    (  var(Type) ->
+       throw(error(instantiation_error, open/4)) % 8.1.3 7)
+    ;
+       lists:member(Type, [text, binary]) -> true
     ;
        throw(error(domain_error(stream_option, type(Type)), _))
     ).
@@ -1439,7 +1442,10 @@ parse_stream_options_(reposition(Bool), reposition-Bool) :-
        throw(error(domain_error(stream_option, reposition(Bool)), _))
     ).
 parse_stream_options_(alias(A), alias-A) :-
-    (  atom(A), A \== [], !, true
+    (  var(A) ->
+       throw(error(instantiation_error, open/4)) % 8.1.3 7)
+    ;
+       atom(A), A \== [] -> true
     ;
        throw(error(domain_error(stream_option, alias(A)), _))
     ).

src/lib/format.pl

@@ -73,6 +73,7 @@
 :- module(format, [format_//2,
                    format/2,
                    format/3,
+                   portray_clause_//1,
                    portray_clause/1,
                    portray_clause/2,
                    listing/1
@@ -83,6 +84,7 @@
 :- use_module(library(error)).
 :- use_module(library(charsio)).
 :- use_module(library(between)).
+:- use_module(library(pio)).
 
 format_(Fs, Args) -->
         { must_be(list, Fs),
@@ -389,18 +391,7 @@ format(Fs, Args) :-
         format(Stream, Fs, Args).
 
 format(Stream, Fs, Args) :-
-        phrase(format_(Fs, Args), Cs),
-        (   stream_property(Stream, type(binary)) ->
-            (   '$first_non_octet'(Cs, N) ->
-                domain_error(byte_char, N, format/3)
-            ;   true
-            )
-        ;   true
-        ),
-        % we use a specialised internal predicate that uses only a
-        % single "write" operation for efficiency. It is equivalent to
-        % maplist(put_char(Stream), Cs). It also works for binary streams.
-        '$put_chars'(Stream, Cs),
+        phrase_to_stream(format_(Fs, Args), Stream),
         flush_output(Stream).
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -477,8 +468,8 @@ portray_clause(Term) :-
         portray_clause(Out, Term).
 
 portray_clause(Stream, Term) :-
-        phrase(portray_clause_(Term), Ls),
-        format(Stream, "~s", [Ls]).
+        phrase_to_stream(portray_clause_(Term), Stream),
+        flush_output(Stream).
 
 portray_clause_(Term) -->
         { unique_variable_names(Term, VNs) },

src/lib/pio.pl

@@ -1,17 +1,38 @@
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   Pure I/O
+   ========
+
+   Our goal is to encourage the use of definite clause grammars (DCGs)
+   for describing strings. The predicates phrase_from_file/[2,3],
+   phrase_to_file/2 and phrase_to_stream/2 let us apply DCGs transparently
+   to files and streams, and therefore decouple side-effects from
+   declarative descriptions.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
 :- module(pio, [phrase_from_file/2,
                 phrase_from_file/3,
-                phrase_to_file/2]).
+                phrase_to_file/2,
+                phrase_to_stream/2
+               ]).
 
 :- use_module(library(dcgs)).
 :- use_module(library(error)).
 :- use_module(library(freeze)).
-:- use_module(library(iso_ext), [setup_call_cleanup/3, partial_string/3]).
-:- use_module(library(lists), [member/2]).
-:- use_module(library(format), [format/3]).
+:- use_module(library(iso_ext), [setup_call_cleanup/3, partial_string/1, partial_string/3]).
+:- use_module(library(lists), [member/2, maplist/2]).
+:- use_module(library(charsio), [read_n_chars/3]).
 
 :- meta_predicate(phrase_from_file(2, ?)).
 :- meta_predicate(phrase_from_file(2, ?, ?)).
 :- meta_predicate(phrase_to_file(2, ?)).
+:- meta_predicate(phrase_to_stream(2, ?)).
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   phrase_from_file(GRBody, File)
+
+   True if grammar rule body GRBody covers the contents of File,
+   represented as a list of characters.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
 phrase_from_file(NT, File) :-
     phrase_from_file(NT, File, []).
@@ -40,19 +61,18 @@ reader_step(Stream, Pos, Xs0) :-
         set_stream_position(Stream, Pos),
         (   at_end_of_stream(Stream)
         ->  Xs0 = []
-        ;   '$get_n_chars'(Stream, 4096, Cs),
+        ;   read_n_chars(Stream, 4096, Cs),
             partial_string(Cs, Xs0, Xs),
             stream_to_lazy_list(Stream, Xs)
         ).
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-   phrase_to_file(+GRBody, +File)
+   phrase_to_stream(+GRBody, +Stream)
 
    Emit the list of characters described by the grammar rule body
-   GRBody to File. File is a string, which is also the representation
-   used by library(files) to test for existence etc. of files.
+   GRBody to Stream.
 
-   An ideal implementation of phrase_to_file/2 writes each character
+   An ideal implementation of phrase_to_stream/2 writes each character
    as soon as it becomes known and no choice-points remain, and thus
    avoids the manifestation of the entire string in memory. See #691
    for more information.
@@ -64,9 +84,31 @@ reader_step(Stream, Pos, Xs0) :-
    represented in memory, and thus covers a large number of use cases.
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
+phrase_to_stream(GRBody, Stream) :-
+        phrase(GRBody, Cs),
+        (   partial_string(Cs) -> % very efficiently check for a string
+            true                  % (success is the expected case here)
+        ;   must_be(list, Cs),
+            maplist(must_be(character), Cs)
+        ),
+        (   stream_property(Stream, type(binary)) ->
+            (   '$first_non_octet'(Cs, N) ->
+                domain_error(byte_char, N, phrase_to_stream/2)
+            ;   true
+            )
+        ;   true
+        ),
+        % we use a specialised internal predicate that uses only a
+        % single "write" operation for efficiency. It is equivalent to
+        % maplist(put_char(Stream), Cs). It also works for binary streams.
+        '$put_chars'(Stream, Cs).
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   phrase_to_file(+GRBody, +File), writing the string described
+   by GRBody to File.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
 phrase_to_file(GRBody, File) :-
-        atom_chars(Atom, File),
-        phrase(GRBody, Chars),
-        setup_call_cleanup(open(Atom, write, Stream),
-                           format(Stream, "~s", [Chars]),
+        setup_call_cleanup(open(File, write, Stream),
+                           phrase_to_stream(GRBody, Stream),
                            close(Stream)).