[m-dev.] for review: stream I/O

[Peter Ross]

Hi,

I have also attached a file main.m which does I/O on string and
stdio streams.

===================================================================


Estimated hours taken: 40

Implement generic stream based I/O.

stream.m:
    Define the stream typeclass and provide some implementations of
    routines which work on streams.

stream.impure.m:
    Define an impure interface which is useful for interfacing streams
    provided by the foreign function interface.

stdio.m:
    Define an instance of the stream typeclass which provides a
    stdin/stdout stream.

string.m:
    Define an instance of the stream typeclass which works on strings.

library.m:
    Include the stream and stdio modules.

Index: library.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.50
diff -u -r1.50 library.m
--- library.m	2000/09/20 12:12:36	1.50
+++ library.m	2000/10/01 17:43:17
@@ -31,7 +31,7 @@
 :- import_module math, getopt, graph, group, int.
 :- import_module io, list, map, multi_map, pqueue, queue, random, relation.
 :- import_module require, set, set_bbbtree, set_ordlist, set_unordlist, stack.
-:- import_module std_util, string, term, term_io, tree234, varset.
+:- import_module std_util, stream, string, term, term_io, tree234, varset.
 :- import_module store, rbtree, parser, lexer, ops.
 :- import_module prolog.
 :- import_module integer, rational.
Index: stdio.m
===================================================================
RCS file: stdio.m
diff -N stdio.m
--- /dev/null	Sat Aug  7 21:45:41 1999
+++ stdio.m	Mon Oct  2 04:43:22 2000
@@ -0,0 +1,135 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2000 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB
+%-----------------------------------------------------------------------------%
+%
+% File: stdio.m
+% Main author: petdr
+% Stability: exceptionally low.
+%
+% A stdin/stdout stream.
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module stdio.
+
+:- interface.
+:- import_module stream, stream__impure.
+:- import_module io.
+
+:- type stdio.
+
+	% XXX This should be an abstract type, but currently you aren't
+	% allowed to have instance declarations that refer to abstract
+	% types which are defined as equivalence types, and this needs
+	% to be an equivalence type so that we can use the typeclass
+	% interface defined in `stream.impure.m'.
+:- type stdio_stream == impure(stdio).
+
+:- instance stream(stdio_stream).
+:- instance stream__input(stdio_stream).
+:- instance stream__output(stdio_stream).
+:- instance stream__duplex(stdio_stream).
+
+:- pred stdio_stream(stdio_stream::uo, io__state::di, io__state::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module char. 
+
+:- type stdio ---> stdio.
+
+stdio_stream(impure(stdio)) --> [].
+
+	% Define the high-level operations using the generic operations
+	% from the stream__impure module.
+:- instance stream(stdio_stream) where [].
+:- instance stream__input(stdio_stream) where [
+	pred(read_character/3) is pure_read_char
+].
+
+:- instance stream__output(stdio_stream) where [
+	pred(write_character/3) is pure_write_char
+].
+
+:- instance stream__duplex(stdio_stream) where [].
+
+%-----------------------------------------------------------------------------%
+
+	% Define the impure lowlevel operations
+:- instance impure(stdio) where [
+	pred(impure__is_error/2) is stdio__is_error
+].
+
+:- instance impure__input(stdio) where [
+	pred(impure__read_char/2) is stdio__read_char,
+	pred(impure__is_eof/1) is stdio__is_eof
+].
+
+:- instance impure__output(stdio) where [
+	pred(impure__write_char/2) is stdio__write_char
+].
+
+:- instance impure__duplex(stdio) where [].
+
+%-----------------------------------------------------------------------------%
+	
+:- pred stdio__read_char(stdio::ui, char::out) is semidet.
+:- pragma c_code(stdio__read_char(_File::ui, Chr::out),
+		[will_not_call_mercury, thread_safe], "{
+	int chr;
+
+	chr = fgetc(stdin);
+	if (chr == EOF) {
+		SUCCESS_INDICATOR = FALSE;
+	} else {
+		SUCCESS_INDICATOR = TRUE;
+		Chr = chr;
+	}
+}").
+
+%-----------------------------------------------------------------------------%
+
+:- pred stdio__write_char(stdio::ui, char::in) is semidet.
+:- pragma c_code(stdio__write_char(_File::ui, Chr::in),
+		[will_not_call_mercury, thread_safe], "{
+	if (fputc(Chr, stdout) == EOF) {
+		SUCCESS_INDICATOR = FALSE;
+	} else {
+		SUCCESS_INDICATOR = TRUE;
+	}
+}").
+
+%-----------------------------------------------------------------------------%
+
+:- pragma c_header_code("#include <errno.h>").
+
+:- pred stdio__is_error(stdio::ui, string::out) is semidet.
+:- pragma c_code(stdio__is_error(_File::ui, Msg::out),
+		[will_not_call_mercury, thread_safe], "{
+	if (ferror(stdin) || ferror(stdout)) {
+		SUCCESS_INDICATOR = TRUE;
+		save_transient_hp();
+		MR_make_aligned_string_copy(Msg, strerror(errno));
+		restore_transient_hp();
+	} else {
+		SUCCESS_INDICATOR = FALSE;
+	}
+}").
+
+:- pred stdio__is_eof(stdio::ui) is semidet.
+:- pragma c_code(stdio__is_eof(_File::ui),
+		[will_not_call_mercury, thread_safe], "{
+	if (feof(stdin)) {
+		SUCCESS_INDICATOR = TRUE;
+	} else {
+		SUCCESS_INDICATOR = FALSE;
+	}
+}").
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: stream.impure.m
===================================================================
RCS file: stream.impure.m
diff -N stream.impure.m
--- /dev/null	Sat Aug  7 21:45:41 1999
+++ stream.impure.m	Mon Oct  2 04:43:22 2000
@@ -0,0 +1,112 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2000 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB
+%-----------------------------------------------------------------------------%
+%
+% File: stream.impure.m.
+% Main author: petdr
+% Stability: exceptionally low.
+%
+% An impure interface for describing streams.
+%
+% This file provides a typeclass for people who want to map streams
+% to a foreign language binding while doing the minimum amount of work.  In
+% particular you need to write much less foreign language code, since
+% you only need to implement a few impure predicates with a well defined
+% interface.
+%
+% This file provides throwing exceptions, grabbing error messages,
+% results packaged into ok/error/eof, and turning C style handle based
+% IO into Mercury di/uo.  That's all it does, but it's something you'll
+% have to do and get right every time you implement a stream, so we have
+% done it for you.
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module stream__impure.
+
+:- interface.
+
+:- import_module char.
+
+:- type impure(S) ---> impure(S).
+
+:- typeclass impure(S) where [
+		% Did an error occur processing the stream?
+	semipure pred impure__is_error(S::ui, string::out) is semidet
+].
+
+:- typeclass impure__input(S) <= impure(S) where [
+		% Read one character from the stream described by S.
+		% Fail if we reach eof or some error condition.
+	impure pred impure__read_char(S::ui, char::out) is semidet,
+
+		% Have we reached the eof for S?
+	semipure pred impure__is_eof(S::ui) is semidet
+].
+
+:- typeclass impure__output(S) <= impure(S) where [
+		% Read one character from the current stream.
+	impure pred impure__write_char(S::ui, char::in) is semidet
+].
+
+:- typeclass impure__duplex(S)
+		<= (impure__input(S), impure__output(S)) where [].
+
+%-----------------------------------------------------------------------------%
+
+	% Define read/write one character whose signatures obey the
+	% constraints of the stream type classes.
+
+:- pred pure_read_char(stream__result(char),
+		impure(S), impure(S)) <= impure__input(S).
+:- mode pure_read_char(out, di, uo) is det.
+
+:- pred pure_write_char(char, impure(S), impure(S)) <= impure__output(S).
+:- mode pure_write_char(in, di, uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+:- import_module exception.
+
+:- pragma promise_pure(pure_read_char/3).
+pure_read_char(Result, impure(Stream), FinalStream) :-
+	( impure impure__read_char(Stream, Chr) ->
+		FinalStream = impure(Stream),
+		Result = ok(Chr)
+	;
+		( semipure impure__is_error(Stream, Error) ->
+			FinalStream = impure(Stream),
+			Result = error(Error)
+		; semipure impure__is_eof(Stream) ->
+			FinalStream = impure(Stream),
+			Result = eof
+		;
+			FinalStream = impure(Stream),
+			Error = "read char failed for an unknown reason",
+			Result = error(Error)
+		)
+	).
+
+%-----------------------------------------------------------------------------%
+
+:- pragma promise_pure(pure_write_char/3).
+pure_write_char(Chr, impure(Stream), FinalStream) :-
+	( impure impure__write_char(Stream, Chr) ->
+		FinalStream = impure(Stream)
+	;
+		( semipure impure__is_error(Stream, Err0) ->
+			Err = Err0
+		;
+			Err = "write char failed but there is no error message"
+		),
+		FinalStream = impure(Stream),
+		throw(stream_error(Err))
+	).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: stream.m
===================================================================
RCS file: stream.m
diff -N stream.m
--- /dev/null	Sat Aug  7 21:45:41 1999
+++ stream.m	Mon Oct  2 04:43:22 2000
@@ -0,0 +1,338 @@
+%-----------------------------------------------------------------------------%*
+% Copyright (C) 2000 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB
+%-----------------------------------------------------------------------------%
+%
+% File: stream.m.
+% Main author: petdr
+% Stability: exceptionally low.
+%
+% This file provides a typeclass for defining streams in Mercury.
+% It is completely pure and you are encouraged to use it to write
+% streams in Mercury.  If however you are a library implementor then you
+% may want to look at the impure interface described in stream.impure.m
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module stream.
+
+:- interface.
+
+:- import_module char, io, list.
+:- include_module stream__impure.
+
+	% The state of one stream of type S.
+:- type stream(S).
+
+	% The type of exceptions thrown by this module.
+:- type stream_error ---> stream_error(string).
+
+:- type stream__result(T)
+	--->	ok(T)
+	;	eof
+	;	error(string)
+	.
+
+:- type stream__result
+	--->	ok
+	;	eof
+	;	error(string)
+	.
+
+	% Given a handle to a stream construct a unique stream object
+	% which can be used to do IO on the stream.
+	% This object initialises its state from the io__state.
+:- pred stream__init(S::in, stream(S)::uo, io__state::di, io__state::uo) is det.
+
+	% Tie the stream back into the io__state.  Omitting this call
+	% may allow the compiler to optimize away the stream I/O.
+:- pred stream__destroy(stream(S)::di, io__state::di, io__state::uo) is det.
+
+	% Initialise a stream which is side effect free.
+:- pred stream__init(S::in, stream(S)::uo) is det <= side_effect_free(S).
+
+	% Destroy a side effect free stream.
+:- pred stream__destroy(stream(S)::di, S::out) is det <= side_effect_free(S).
+
+%-----------------------------------------------------------------------------%
+
+	%
+	% The pure interface to streams.
+	% Note if you are using streams you probably want to use the
+	% read_char and write_char routines, this interface should only
+	% be used to define new stream types.
+	%
+:- typeclass stream(S) where [
+].
+
+:- typeclass stream__input(S) <= stream(S) where [
+		% Read one character from the stream S.
+	pred stream__read_character(stream__result(char), S, S),
+	mode stream__read_character(out, di, uo) is det
+].
+
+:- typeclass stream__output(S) <= stream(S) where [
+		% Write one character to the stream S.
+	pred stream__write_character(char, S, S),
+	mode stream__write_character(in, di, uo) is det
+].
+
+:- typeclass stream__duplex(S)
+		<= (stream__input(S), stream__output(S)) where [].
+
+%-----------------------------------------------------------------------------%
+
+	%
+	% A type which doesn't need to be linked with an io__state when
+	% initialising the stream, ie string.
+	%
+:- typeclass stream__side_effect_free(S) where [].
+
+%-----------------------------------------------------------------------------%
+
+% Predicates which require an input stream.
+
+	% Read one character from the input stream.
+:- pred stream__read_char(stream__result(char)::out,
+		stream(S)::di, stream(S)::uo) is det <= stream__input(S).
+
+	% Putback one character into the input stream.
+	% You can putback as many characters as required.
+:- pred stream__putback_char(char::in,
+		stream(S)::di, stream(S)::uo) is det <= stream__input(S).
+
+	% Reads a whitespace delimited word from the current input stream.
+:- pred stream__read_word(stream__result(list(char)),
+		stream(S), stream(S)) <= stream__input(S).
+:- mode stream__read_word(out, di, uo) is det.
+
+	% Reads one line of input from the current input stream.
+:- pred stream__read_line(stream__result(list(char)),
+		stream(S), stream(S)) <= stream__input(S).
+:- mode stream__read_line(out, di, uo) is det.
+
+	% Discards all the whitespace from the current stream.
+:- pred stream__ignore_whitespace(stream__result,
+		stream(S), stream(S)) <= stream__input(S).
+:- mode stream__ignore_whitespace(out, di, uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+% Predicates which require an output stream.
+% On failure these predicates will throw an stream_error exception.
+
+	% Write one char to the output stream.
+:- pred stream__write_char(char::in,
+		stream(S)::di, stream(S)::uo) is det <= stream__output(S).
+
+	% Write the string to the output stream.
+:- pred stream__write_string(string,
+		stream(S), stream(S)) <= stream__output(S).
+:- mode stream__write_string(in, di, uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+	% Echo the input of a duplex stream to the output of the duplex
+	% stream.
+:- pred stream__cat(stream(S)::di, stream(S)::uo) is det <= stream__duplex(S).
+
+	% Echo the input stream to the output stream.
+:- pred stream__cat(stream(S)::di, stream(S)::uo,
+		stream(T)::di, stream(T)::uo) is det <=
+		(stream__input(S), stream__output(T)).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module exception, string.
+
+:- type stream(S)
+	--->	stream(
+			S,		% the stream state
+			list(char)	% Putback characters
+		).
+
+stream__init(S, stream(Stream, [])) --> { copy(S, Stream) }.
+stream__init(S, stream(Stream, [])) :- copy(S, Stream).
+
+stream__destroy(_S) --> [].
+stream__destroy(stream(S, _), S).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+stream__read_char(Result, stream(Stream0, PutbackChars),
+		stream(Stream, NewPutbackChars)) :-
+	(
+		PutbackChars = [],
+		stream__read_character(Result, Stream0, Stream),
+		NewPutbackChars = PutbackChars
+	;
+		PutbackChars = [Chr | NewPutbackChars],
+		Stream = Stream0,
+		Result = ok(Chr)
+	).
+
+%-----------------------------------------------------------------------------%
+
+stream__putback_char(Chr, stream(Stream, PutbackChars), 
+		stream(Stream, [UniqueChr | PutbackChars])) :-
+	copy(Chr, UniqueChr).
+
+%-----------------------------------------------------------------------------%
+
+stream__write_char(Chr, stream(Stream0, Cs), stream(Stream, Cs)) :-
+	stream__write_character(Chr, Stream0, Stream).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+stream__read_word(Result) -->
+	stream__ignore_whitespace(WSResult),
+	(
+		{ WSResult = error(Error) },
+		{ Result = error(Error) }
+	;
+		{ WSResult = eof },
+		{ Result = eof }
+	;
+		{ WSResult = ok },
+		stream__read_word_2(Result)
+	).
+
+:- pred read_word_2(stream__result(list(char)),
+		stream(S), stream(S)) <= stream__input(S).
+:- mode read_word_2(out, di, uo) is det.
+
+read_word_2(Result) -->
+	stream__read_char(CharResult),
+	(
+		{ CharResult = error(Error) },
+		{ Result = error(Error) }
+	;
+		{ CharResult = eof },
+		{ Result = eof }
+	;
+		{ CharResult = ok(Char) },
+		( { char__is_whitespace(Char) } ->
+			stream__putback_char(Char),
+			{ Result = ok([]) }
+		;
+			read_word_2(Result0),
+			(
+				{ Result0 = ok(Chars) },
+				{ Result = ok([Char | Chars]) }
+			;
+				{ Result0 = error(_) },
+				{ Result = Result0 }
+			;
+				{ Result0 = eof },
+				{ Result = ok([Char]) }
+			)
+		)	
+	).
+
+read_line(Result) -->
+	stream__read_char(CharResult),
+	(
+		{ CharResult = error(Error) },
+		{ Result = error(Error) }
+	;
+		{ CharResult = eof },
+		{ Result = eof }
+	;
+		{ CharResult = ok(Char) },
+		( { Char = '\n' } ->
+			{ Result = ok([Char]) }
+		;
+			read_line(Result0),
+			(
+				{ Result0 = ok(Chars) },
+				{ Result = ok([Char | Chars]) }
+			;
+				{ Result0 = error(_) },
+				{ Result = Result0 }
+			;
+				{ Result0 = eof },
+				{ Result = ok([Char]) }
+			)
+		)	
+	).
+
+stream__ignore_whitespace(Result) -->
+	stream__read_char(CharResult),
+	(
+		{ CharResult = error(Error) },
+		{ Result = error(Error) }
+	;
+		{ CharResult = eof },
+		{ Result = eof }
+	;
+		{ CharResult = ok(Char) },
+		( { char__is_whitespace(Char) } ->
+			stream__ignore_whitespace(Result)
+		;
+			stream__putback_char(Char),
+			{ Result = ok }
+		)	
+	).
+
+%-----------------------------------------------------------------------------%
+
+stream__write_string(String) -->
+	{ string__to_char_list(String, CharList) },
+	list__foldl(stream__write_char, CharList).
+
+%-----------------------------------------------------------------------------%
+
+stream__cat -->
+	stream__read_char(Result),
+	(
+		{ Result = ok(Char) },
+		stream__write_char(Char),
+		cat
+	;
+		{ Result = eof }
+	;
+		{ Result = error(String) },
+		{ throw(stream_error(
+			string__format("stream__cat: %s.", [s(String)]))) }
+	).
+	
+stream__cat(S0, S) -->
+	{ stream__read_char(Result, S0, S1) },
+	(
+		{ Result = ok(Char) },
+		stream__write_char(Char),
+		cat(S1, S)
+	;
+		{ Result = eof },
+		{ S = S1 }
+	;
+		{ Result = error(String) },
+		{ throw(stream_error(
+			string__format("stream__cat: %s.", [s(String)]))) }
+	).
+	
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- func state_init = c_pointer.
+:- mode state_init = uo is det.
+:- pragma c_code(state_init = (State::uo),
+		[will_not_call_mercury, thread_safe], "{
+	State = 0;
+}").
+
+:- pred state_update(c_pointer::di, c_pointer::uo) is det.
+:- pragma c_code(state_update(State0::di, State::uo),
+		[will_not_call_mercury, thread_safe], "{
+	State = State0;
+}").
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: string.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/string.m,v
retrieving revision 1.131
diff -u -r1.131 string.m
--- string.m	2000/09/28 07:40:40	1.131
+++ string.m	2000/10/01 17:43:28
@@ -20,7 +20,14 @@
 
 :- interface.
 :- import_module list, char.
+:- import_module stream.
 
+:- instance stream(string).
+:- instance stream__input(string).
+:- instance stream__output(string).
+:- instance stream__duplex(string).
+:- instance stream__side_effect_free(string).
+
 :- pred string__length(string, int).
 :- mode string__length(in, uo) is det.
 	% Determine the length of a string.
@@ -362,6 +369,33 @@
 
 :- implementation.
 :- import_module bool, std_util, int, float, require.
+
+:- instance stream(string) where [].
+:- instance stream__input(string) where [
+	pred(read_character/3) is read_char
+].
+:- instance stream__output(string) where [
+	pred(write_character/3) is write_char
+].
+:- instance stream__duplex(string) where [].
+:- instance stream__side_effect_free(string) where [].
+
+:- pred read_char(stream__result(char)::out, string::di, string::uo) is det.
+
+read_char(Result, String0, String) :-
+	( string__first_char(String0, Char, String1) ->
+		Result = ok(Char),
+		copy(String1, String)
+	;
+		Result = eof,
+		copy(String0, String)
+	).
+		
+:- pred write_char(char::in, string::di, string::uo) is det.
+
+write_char(Char, String0, String) :-
+	string__append(String0, string__char_to_string(Char), String1),
+	copy(String1, String).
 
 :- pred string__to_int_list(string, list(int)).
 :- mode string__to_int_list(out, in) is det.

-------------- next part --------------
:- module main.
:- interface.
:- import_module io.
:- pred main(io__state::di, io__state::uo) is det.

:- implementation.
:- import_module stdio, stream, string.
:- import_module list.

main -->
	io__write_string("Hello world.\n"),

	stdio_stream(StdioStream),
	stream__init(StdioStream, Stream0),
	{ generic_io(Stream0, Stream) },
	stream__destroy(Stream),

	{ stream__init("", Stream0A) },
	{ generic_io(Stream0A, StreamA) },
	{ stream__destroy(StreamA, String) },
	io__write_string(String).

:- pred generic_io(stream(S)::di, stream(S)::uo) is det <= stream__output(S).

generic_io -->
	stream__write_string("Hello world from stream library.\n").