[m-dev.] Stream2000

[Peter Ross]

I forget which version I am too. ;)

Here is a version of streams which uses io__states to avoid the semantic
problems with previous versions.

I need to clean this up some more, but I also need to catch my bus so I
thought I would put out a preliminary version for comment.

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

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

	%
	% The pure interface to streams.
	%
:- typeclass stream(S) where [
].

:- typeclass stream__input(S) <= stream(S) where [
		% Read one character from the stream S.
	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.
	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 [
	pred stream__putback_char(S::in, char::in,
			io__state::di, io__state::uo) is det
].

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

	%
	% Create a stream with infinite putback from an input stream.
	%
:- some [T] (func putback_stream(S) = T
		=> stream__putback(T)) <= 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).

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

:- implementation.

:- import_module string.

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

:- instance stream(putback(S)) <= stream(S) where [].

:- 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
].

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

:- pragma promise_pure(putback_stream/1).
putback_stream(Stream) = pb(Stream, MPutbackChars) :-
	impure new_mutvar([], MPutbackChars).

:- pragma promise_pure(putback_read_char/4).
putback_read_char(pb(Stream, MPutbackChars), Result) -->
	{ impure get_mutvar(MPutbackChars, PutbackChars) },
	(
		{ PutbackChars = [] },
		stream__read_char(Stream, Result)
	;
		{ PutbackChars = [Char | NewPutbackChars] },
		{ Result = ok(Char) },
		{ impure set_mutvar(MPutbackChars, NewPutbackChars) }
	).

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

:- pragma promise_pure(putback_putback_char/4).
putback_putback_char(pb(_Stream, MPutbackChars), Char) -->
	{ impure get_mutvar(MPutbackChars, PutbackChars) },
	{ impure set_mutvar(MPutbackChars, [Char | PutbackChars] ) }.

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

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]) }
			)
		)	
	).

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

stream__read_word(Stream, Result) -->
	stream__ignore_whitespace(Stream, WSResult),
	(
		{ WSResult = error(Error) },
		{ Result = error(Error) }
	;
		{ WSResult = eof },
		{ Result = eof }
	;
		{ WSResult = ok },
		stream__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) -->
	stream__read_char(Stream, CharResult),
	(
		{ CharResult = error(Error) },
		{ Result = error(Error) }
	;
		{ CharResult = eof },
		{ Result = eof }
	;
		{ CharResult = ok(Char) },
		( { char__is_whitespace(Char) } ->
			stream__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]) }
			)
		)	
	).

stream__ignore_whitespace(Stream, Result) -->
	stream__read_char(Stream, CharResult),
	(
		{ CharResult = error(Error) },
		{ Result = error(Error) }
	;
		{ CharResult = eof },
		{ Result = eof }
	;
		{ CharResult = ok(Char) },
		( { char__is_whitespace(Char) } ->
			stream__ignore_whitespace(Stream, Result)
		;
			stream__putback_char(Stream, Char),
			{ Result = ok }
		)	
	).

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

stream__write_string(Stream, String) -->
	string__foldl(stream__write_char(Stream), String).
	
%-----------------------------------------------------------------------------%

%%% :- module mutvar.
%%% :- interface.

%  A non-backtrackably destructively modifiable reference type
:- type mutvar(T).

%  Create a new mutvar given a term for it to reference.
:- impure pred new_mutvar(T, mutvar(T)).
:-        mode new_mutvar(in, out) is det.
:-        mode new_mutvar(di, uo) is det.

%  Get the value currently referred to by a reference.
:- impure pred get_mutvar(mutvar(T), T) is det.
:-        mode get_mutvar(in, uo) is det.	% XXX this is a work-around
/*
XXX `ui' modes don't work yet
:-        mode get_mutvar(in, uo) is det.
:-        mode get_mutvar(ui, uo) is det.	% unsafe, but we use it safely
*/

%  destructively modify a reference to refer to a new object.
:- impure pred set_mutvar(mutvar(T), T) is det.
:-        mode set_mutvar(in, in) is det.
/*
XXX `ui' modes don't work yet
:-        pred set_mutvar(ui, di) is det.
*/

%%% :- implementation.

%  This type is implemented in C.
:- type mutvar(T) ---> mutvar(c_pointer).

:- pragma inline(new_mutvar/2).
:- pragma c_code(new_mutvar(X::in, Ref::out), will_not_call_mercury,
"
	incr_hp_msg(Ref, 1, MR_PROC_LABEL, ""std_util:mutvar/1"");
	*(MR_Word *) Ref = X;
").
:- pragma c_code(new_mutvar(X::di, Ref::uo), will_not_call_mercury,
"
	incr_hp_msg(Ref, 1, MR_PROC_LABEL, ""std_util:mutvar/1"");
	*(MR_Word *) Ref = X;
").

:- pragma inline(get_mutvar/2).
:- pragma c_code(get_mutvar(Ref::in, X::uo), will_not_call_mercury,
"
	X = *(MR_Word *) Ref;
").

:- pragma inline(set_mutvar/2).
:- pragma c_code(set_mutvar(Ref::in, X::in), will_not_call_mercury, "
	*(MR_Word *) Ref = X;
").

%%% end_module mutvar.

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

:- module (impure).

:- interface.

:- import_module stream.
:- import_module char.

	% A handle on the impure stream.
:- type impure(S) ---> 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.
	semipure 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.
	impure pred impure__write_char(S::in, char::in) is semidet
].

:- typeclass impure__duplex(S)
		<= (impure__input(S), impure__output(S)) where [].

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

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

:- pragma promise_pure(pure_read_char/4).
pure_read_char(impure(Stream), Result, IO, IO) :-
	( impure impure__read_char(Stream, Chr) ->
		Result = ok(Chr)
	;
		( semipure 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)
		)
	).

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

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

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