[m-dev.] Stream2000

[Peter Ross]

I have switched over to using abstract types.
-------------- next part --------------
%-----------------------------------------------------------------------------%*
% 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 impure.m
%
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- module stream.

:- interface.

:- import_module char, io, list.

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

:- type stream__res
	--->	ok
	;	error(string)
	.

%-----------------------------------------------------------------------------%

	%
	% The pure interface to streams.
	%
:- typeclass stream(S) where [
		% A name describing the current stream.
	func stream__name(S) = string
].

:- typeclass stream__input(S) <= stream(S) where [
		% Read one character from the stream S.
		% Errors are reported via the stream__result type.
	pred stream__read_char(S::in, stream__result(char)::out,
			io__state::di, io__state::uo) is det
].

:- typeclass stream__output(S) <= stream(S) where [
		% Write one character to the stream S.
		% Throws a stream_error exception if a problem occurs.
	pred stream__write_char(S::in, char::in,
			io__state::di, io__state::uo) is det
].

:- typeclass stream__duplex(S)
		<= (stream__input(S), stream__output(S)) where [].

:- typeclass stream__putback(S) <= stream__input(S) where [
		% Putback one character on the input stream.
		% The implementation must guarantee at least one
		% character of putback and throw a stream_error
		% exception if a problem is encountered during the
		% putback.
	pred stream__putback_char(S::in, char::in,
			io__state::di, io__state::uo) is det
].

:- typeclass stream__line(S) <= stream__input(S) where [
		% Return the line number of the input stream.
		% Lines are numbered starting from one.
	pred stream__line_number(S::in, int::out,
			io__state::di, io__state::uo) is det,

		% Set the line number of the input stream.
	pred stream__set_line_number(S::in, int::in,
			io__state::di, io__state::uo) is det

].

%-----------------------------------------------------------------------------%

	%
	% A input stream with infinite putback.
	%
:- type putback(S).
:- instance stream(putback(S)) <= stream(S).
:- instance stream__input(putback(S)) <= stream__input(S).
:- instance stream__putback(putback(S)) <= stream__input(S).

	% Create the putback stream.
:- pred putback_stream(S::in, putback(S)::out,
		io__state::di, io__state::uo) is det <= stream__input(S).

%-----------------------------------------------------------------------------%

	%
	% A stream which records which line of the input stream we are
	% up to.  Lines are numbered starting from one.
	%
:- type linenumber(S).
:- instance stream(linenumber(S)) <= stream(S).
:- instance stream__input(linenumber(S)) <= stream__input(S).
:- instance stream__putback(linenumber(S)) <= stream__putback(S).
:- instance stream__line(linenumber(S)) <= stream__input(S).

	% Create the numbered stream.
:- pred linenumber_stream(S::in, linenumber(S)::out,
		io__state::di, io__state::uo) is det <= stream__input(S).

%-----------------------------------------------------------------------------%

% XXX When default type class implementations are introduced these
% the following predicates should probably become members of the
% relevant type classes.

% Predicates which require an input stream.

	% Reads one line of input from the current input stream.
:- pred stream__read_line(S::in, stream__result(list(char))::out,
		io__state::di, io__state::uo) is det <= stream__input(S).

%-----------------------------------------------------------------------------%

% Predicates which require an input stream with putback.

	% Reads a whitespace delimited word from the current input stream.
:- pred stream__read_word(S::in, stream__result(list(char))::out,
		io__state::di, io__state::uo) is det <= stream__putback(S).

	% Discards all the whitespace from the input stream.
:- pred stream__ignore_whitespace(S::in, stream__result::out,
		io__state::di, io__state::uo) is det <= stream__putback(S).

%-----------------------------------------------------------------------------%

% Predicates which require an output stream.
% On failure these predicates will throw an stream_error exception.

	% Write the string to the output stream.
:- pred stream__write_string(S::in, string::in,
		io__state::di, io__state::uo) is det <= stream__output(S).

%-----------------------------------------------------------------------------%

% Predicates which require an input and a output stream.

	% Echo stream S onto stream T.
	% Errors associated with stream S are reported through the
	% stream__res argument.  Errors associated with stream T throw a
	% stream_error exception.
:- pred cat(S::in, T::in, stream__res::out,
		io__state::di, io__state::uo) is det
		<= (stream__input(S), stream__output(T)).

%-----------------------------------------------------------------------------%

:- implementation.

:- import_module mutvar.
:- import_module int, string.

:- type putback(S)
	--->	pb(
			S,
			mutvar(list(char))
		).

:- instance stream(putback(S)) <= stream(S) where [
	(stream__name(pb(S, _)) = stream__name(S))
].

:- instance stream__input(putback(S)) <= stream__input(S) where [
	pred(stream__read_char/4) is putback_read_char
].

:- instance stream__putback(putback(S)) <= stream__input(S) where [
	pred(stream__putback_char/4) is putback_putback_char
].

putback_stream(Stream, pb(Stream, MPutbackChars)) -->
	mutvar__init(MPutbackChars),
	mutvar__put(MPutbackChars, []).

:- pred putback_read_char(putback(S)::in, stream__result(char)::out,
		io__state::di, io__state::uo) is det <= stream__input(S).

putback_read_char(pb(Stream, MPutbackChars), Result) -->
	mutvar__take(MPutbackChars, PutbackChars),
	(
		{ PutbackChars = [] },
		{ NewPutbackChars = PutbackChars },
		stream__read_char(Stream, Result)
	;
		{ PutbackChars = [Char | NewPutbackChars] },
		{ Result = ok(Char) }
	),
	mutvar__put(MPutbackChars, NewPutbackChars).

:- pred putback_putback_char(putback(S)::in, char::in,
		io__state::di, io__state::uo) is det <= stream__input(S).

putback_putback_char(pb(_Stream, MPutbackChars), Char) -->
	mutvar__take(MPutbackChars, PutbackChars),
	mutvar__put(MPutbackChars, [Char | PutbackChars]).

%-----------------------------------------------------------------------------%

:- type linenumber(S)
	--->	line(
			S,		% stream
			mutvar(int)	% line number
		).

:- instance stream(linenumber(S)) <= stream(S) where [
	(stream__name(line(S, _)) = stream__name(S))
].

:- instance stream__input(linenumber(S)) <= stream__input(S) where [
	pred(stream__read_char/4) is linenumber_read_char
].

:- instance stream__putback(linenumber(S)) <= stream__putback(S) where [
	pred(stream__putback_char/4) is linenumber_putback_char
].

:- instance stream__line(linenumber(S)) <= stream__input(S) where [
	pred(stream__line_number/4) is linenumber,
	pred(stream__set_line_number/4) is set_linenumber
].

linenumber_stream(S, line(S, MLine)) -->
	mutvar__init(MLine),
	mutvar__put(MLine, 0).

:- pred linenumber_read_char(linenumber(S)::in, stream__result(char)::out,
		io__state::di, io__state::uo) is det <= stream__input(S).

linenumber_read_char(line(Stream, MLine), Result) -->
	mutvar__take(MLine, Line),
	stream__read_char(Stream, Result),
	( { Result = ok('\n') } ->
		mutvar__put(MLine, Line + 1)
	;
		mutvar__put(MLine, Line)
	).

:- pred linenumber_putback_char(linenumber(S)::in, char::in,
		io__state::di, io__state::uo) is det <= stream__putback(S).

linenumber_putback_char(line(Stream, MLine), Char) -->
	mutvar__take(MLine, Line),
	stream__putback_char(Stream, Char),
	( { Char = '\n' } ->
		mutvar__put(MLine, Line - 1)
	;
		mutvar__put(MLine, Line)
	).

:- pred linenumber(linenumber(S)::in, int::out,
		io__state::di, io__state::uo) is det.

linenumber(line(_, MLine), Line) -->
	mutvar__take(MLine, Line),
	mutvar__put(MLine, Line).

:- pred set_linenumber(linenumber(S)::in, int::in,
		io__state::di, io__state::uo) is det.

set_linenumber(line(_, MLine), Line) -->
	mutvar__take(MLine, _OldLine),
	mutvar__put(MLine, Line).

%-----------------------------------------------------------------------------%

read_line(Stream, Result) -->
	stream__read_char(Stream, CharResult),
	(
		{ CharResult = error(Error) },
		{ Result = error(Error) }
	;
		{ CharResult = eof },
		{ Result = eof }
	;
		{ CharResult = ok(Char) },
		( { Char = '\n' } ->
			{ Result = ok([Char]) }
		;
			read_line(Stream, Result0),
			(
				{ Result0 = ok(Chars) },
				{ Result = ok([Char | Chars]) }
			;
				{ Result0 = error(_) },
				{ Result = Result0 }
			;
				{ Result0 = eof },
				{ Result = ok([Char]) }
			)
		)	
	).

%-----------------------------------------------------------------------------%

read_word(Stream, Result) -->
	ignore_whitespace(Stream, WSResult),
	(
		{ WSResult = error(Error) },
		{ Result = error(Error) }
	;
		{ WSResult = eof },
		{ Result = eof }
	;
		{ WSResult = ok },
		read_word_2(Stream, Result)
	).

:- pred read_word_2(S::in, stream__result(list(char))::out,
		io__state::di, io__state::uo) is det <= stream__putback(S).

read_word_2(Stream, Result) -->
	read_char(Stream, CharResult),
	(
		{ CharResult = error(Error) },
		{ Result = error(Error) }
	;
		{ CharResult = eof },
		{ Result = eof }
	;
		{ CharResult = ok(Char) },
		( { char__is_whitespace(Char) } ->
			putback_char(Stream, Char),
			{ Result = ok([]) }
		;
			read_word_2(Stream, Result0),
			(
				{ Result0 = ok(Chars) },
				{ Result = ok([Char | Chars]) }
			;
				{ Result0 = error(_) },
				{ Result = Result0 }
			;
				{ Result0 = eof },
				{ Result = ok([Char]) }
			)
		)	
	).

ignore_whitespace(Stream, Result) -->
	read_char(Stream, CharResult),
	(
		{ CharResult = error(Error) },
		{ Result = error(Error) }
	;
		{ CharResult = eof },
		{ Result = eof }
	;
		{ CharResult = ok(Char) },
		( { char__is_whitespace(Char) } ->
			ignore_whitespace(Stream, Result)
		;
			putback_char(Stream, Char),
			{ Result = ok }
		)	
	).

%-----------------------------------------------------------------------------%

write_string(Stream, String) -->
	string__foldl(write_char(Stream), String).
	
%-----------------------------------------------------------------------------%

cat(In, Out, Result) -->
	stream__read_char(In, Res),
	(
		{ Res = ok(Char) },
		stream__write_char(Out, Char),
		cat(In, Out, Result)
	;
		{ Res = eof },
		{ Result = ok }
	;
		{ Res = error(Error) },
		{ Result = error(Error) }
	).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-------------- next part --------------
%-----------------------------------------------------------------------------%
% 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: 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.
%
% An instance of the pure interface is then easily obtained, as shown by
% the following instance declarations.
%
% :- instance stream__input(impure(your_type)) where [
%	(stream__read_char(S, R) --> pure_read_char(S, R))
% ].
% :- instance stream__output(impure(your_type)) where [
%	(stream__write_char(S, C) --> pure_write_char(S, C))
% ].
%
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- module (impure).

:- interface.

:- import_module stream.
:- import_module char.

	% A handle on the impure stream.
:- type impure(S).

:- typeclass impure(S) where [
		% Did an error occur processing the stream?
		% This predicate must also clear the error status of a
		% stream after reporting the error.
	impure pred impure__get_error(S::in, 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::in, char::out) is semidet,

		% Have we reached the eof for S?
	semipure pred impure__is_eof(S::in) is semidet
].

:- typeclass impure__output(S) <= impure(S) where [
		% Read one character from the current stream.
		% Fail if there is some error reading.
	impure pred impure__write_char(S::in, char::in) is semidet
].

:- pred impure_init(S::in, impure(S)::out, io__state::di, io__state::uo) is det.

%-----------------------------------------------------------------------------%

	% Read one character of input.  This read character
	% implementation can be used in instance declarations for the
	% stream__input type class.

:- pred pure_read_char(impure(S), stream__result(char),
		io__state, io__state) <= impure__input(S).
:- mode pure_read_char(in, out, di, uo) is det.

	% Write one character of output.  This write character
	% implementation can be used in instance declarations for the
	% stream__output type class.

:- pred pure_write_char(impure(S), char,
		io__state, io__state) <= impure__output(S).
:- mode pure_write_char(in, in, di, uo) is det.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- implementation.

:- import_module mutvar.
:- import_module exception, std_util.

:- type impure(S)
	--->	impure(
			S,		% Handle
			mutvar(unit)	% Mutvar used as a semaphore to
					% ensure the atomicity of
					% read/write char.
		).

impure_init(S, impure(S, MVar)) -->
	mutvar__init(MVar),
	mutvar__put(MVar, unit).

:- pragma promise_pure(pure_read_char/4).
pure_read_char(impure(Stream, MVar), Result, IO0, IO) :-
	mutvar__take(MVar, Unit, IO0, IO1),
	( impure impure__read_char(Stream, Chr) ->
		Result = ok(Chr)
	;
		( impure impure__get_error(Stream, Error) ->
			Result = error(Error)
		; semipure impure__is_eof(Stream) ->
			Result = eof
		;
			Error = "read char failed for an unknown reason",
			Result = error(Error)
		)
	),
	mutvar__put(MVar, Unit, IO1, IO).

%-----------------------------------------------------------------------------%

:- pragma promise_pure(pure_write_char/4).
pure_write_char(impure(Stream, MVar), Chr, IO0, IO) :-
	mutvar__take(MVar, Unit, IO0, IO1),
	( impure impure__write_char(Stream, Chr) ->
		mutvar__put(MVar, Unit, IO1, IO)
	;
		( impure impure__get_error(Stream, Err0) ->
			Err = Err0
		;
			Err = "write char failed but there is no error message"
		),
		mutvar__put(MVar, Unit, IO1, IO),
		throw(stream_error(Err))
	).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%