[m-rev.] for review: add string builder stream to extras

Ian MacLarty maclarty at csse.unimelb.edu.au
Mon Nov 27 15:57:20 AEDT 2006


For review by Julien.

Estimated hours taken: 2
Branches: main

Add a string_builder stream to extras.  This stream can be used to build a
string using predicates that write to string or character streams.

extras/README:
extras/stream/README:
	Document the new contents of the stream directory.

extras/stream/Mmakefile:
	Change the mmake rules to build libstream_util instead of the
	now deprecated stream library.

extras/stream/stream.m:
extras/stream/stream_old.m:
	Rename stream.m to stream_old.m.

extras/stream/stream_util.m:
	The new stream_util library.

extras/stream/stream_util.string_builder.m:
	The new string builder module.

stream/tests/Makefile:
stream/tests/stream_util_test.exp:
stream/tests/stream_util_test.m:
	Add a test case for  string builder streams.

Index: README
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/README,v
retrieving revision 1.22
diff -u -r1.22 README
--- README	16 Nov 2006 04:04:24 -0000	1.22
+++ README	27 Nov 2006 02:56:24 -0000
@@ -82,9 +82,8 @@
 		adapted to make them suitable for use with solver
 		types.
 
-stream		Generic IO interface using typeclasses.
-		Note this interface has been superceded by the one
-		in standard library.
+stream		Utility streams that use the stream interface in the
+		standard library.
 
 trailed_update	Some library modules that make use of backtrackable
 		destructive update, including a module which provides
Index: stream/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/stream/Mmakefile,v
retrieving revision 1.2
diff -u -r1.2 Mmakefile
--- stream/Mmakefile	22 Nov 2001 11:04:40 -0000	1.2
+++ stream/Mmakefile	27 Nov 2006 03:15:03 -0000
@@ -6,19 +6,6 @@
 
 -include ../Mmake.params
 
-MAIN_TARGET=libstream
+MAIN_TARGET=libstream_util
 
-depend: stream.depend
-
-stream stream.depend: mvar.m semaphore.m
-
-mvar.m: ../concurrency/mvar.m
-	cp ../concurrency/mvar.m .
-semaphore.m: ../concurrency/semaphore.m
-	cp ../concurrency/semaphore.m .
-
-realclean:
-	rm -f mvar.m semaphore.m
-
-check: libstream
-	true
+depend: stream_util.depend
Index: stream/README
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/stream/README,v
retrieving revision 1.2
diff -u -r1.2 README
--- stream/README	22 Nov 2001 11:04:41 -0000	1.2
+++ stream/README	27 Nov 2006 04:42:58 -0000
@@ -1,30 +1,20 @@
-This directory contains an implementation of generic IO streams in Mercury.
-The streams interface uses type classes, so that users can define their
-own stream types and can write generic code that will work on any
-appropriate stream.
+This directory contains various instances of the stream typeclass defined
+in the Mercury standard library.  The instances implement various utility
+streams.
 
-To build this library you need mvar.m and semaphore.m from the
-extras/concurrency directory.  (The Mmakefile rules should copy these
-here automatically.)
+stream_util.m:
+	The top-level package.
 
-The following files implement the stream interfaces at various levels
+stream_util.string_builder.m:
+	A stream that can be used to build up strings from predicates that
+	write to any string or character streams.
 
-    stream.m
-        The pure high-level interface.  This is the interface external
-        code should use to the stream library.  The file also contains
-        examples of extending any stream with infinite putback and/or
-        line numbering.
+tests/:
+	Some test cases.  To run the tests, change to this directory and
+	type "make".
 
-    lowlevel.m
-        A pure low-level interface.  This interface is more useful for
-        using the foreign language binding to define a new stream
-        type.  This file also provides implementations of read/write one
-        char which can be used in instance declarations for the
-        highlevel stream typeclasses.  This allows an implementor to do
-        the minimum amount of work to achieve an instance of the
-        highlevel stream type class.
-         
-    impure.m
-        An impure low-level interface, which provides the same
-        functionality as lowlevel.m except the interface methods are
-        impure.
+lowlevel.m:
+impure.m:
+stream_old.m:
+	These files are part of the old stream interface, which has now been
+	deprecated.
Index: stream/stream.m
===================================================================
RCS file: stream/stream.m
diff -N stream/stream.m
--- stream/stream.m	30 Mar 2006 01:21:19 -0000	1.3
+++ /dev/null	1 Jan 1970 00:00:00 -0000
@@ -1,439 +0,0 @@
-%-----------------------------------------------------------------------------%*
-% Copyright (C) 2000-2001, 2006 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 lowlevel interface described in lowlevel.m or
-% 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.
-%
-
-	% The root of the stream class hierarchy
-:- typeclass stream(S) where [
-		% A human-readable name describing the current stream
-		% suitable for use in (e.g.) error messages.
-	func stream__name(S) = string
-].
-
-	% Streams from which you can read input.
-:- 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
-].
-
-	% Streams to which you can write output.
-:- 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
-].
-
-	% Streams which can be both read from and written to.
-:- typeclass stream__duplex(S)
-		<= (stream__input(S), stream__output(S)) where [].
-
-	% Stream for which characters can be put back at the start of
-	% the stream.
-:- 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
-].
-
-	% Stream with an unbounded amounts of putback.
-	% This adds no new methods, just a guarantee:
-	% there's no limit on the amount of putback except available
-	% memory, so unless you run out of heap space, the putback_char
-	% method must always succeed.
-:- typeclass stream__unbounded_putback(S) <= stream__putback(S) where [].
-
-:- 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).
-
-	% Retrieve the original stream.
-:- func putback_base_stream(putback(S)) = 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 a line-number counting stream.
-:- pred linenumber_stream(S::in, linenumber(S)::out,
-		io__state::di, io__state::uo) is det <= stream__input(S).
-
-	% Retrieve the original stream.
-:- func linenumber_base_stream(linenumber(S)) = S.
-
-%-----------------------------------------------------------------------------%
-
-% XXX If/when default type class implementations are introduced,
-% some of 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 InputS onto stream OutputS.
-	% Errors associated with stream InputS are reported through the
-	% stream__res argument.  Errors associated with stream OutputS
-	% throw a stream_error exception.
-:- pred cat(InputS::in, OutputS::in, stream__res::out,
-		io__state::di, io__state::uo) is det
-		<= (stream__input(InputS), stream__output(OutputS)).
-
-%-----------------------------------------------------------------------------%
-
-:- implementation.
-
-	% These two imports are only so that when building a stand-alone
-	% stream library we include the following modules in the
-	% library.
-:- import_module (impure), lowlevel.
-
-:- import_module mvar.
-:- import_module int, string.
-
-
-:- type stream(S) ---> stream.
-
-:- type putback(S)
-	--->	pb(
-			S,
-			mvar(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)) -->
-	mvar__init(MPutbackChars),
-	mvar__put(MPutbackChars, []).
-
-putback_base_stream(pb(Stream, _)) = Stream.
-
-:- 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) -->
-	mvar__take(MPutbackChars, PutbackChars),
-	(
-		{ PutbackChars = [] },
-		{ NewPutbackChars = PutbackChars },
-		stream__read_char(Stream, Result)
-	;
-		{ PutbackChars = [Char | NewPutbackChars] },
-		{ Result = ok(Char) }
-	),
-	mvar__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) -->
-	mvar__take(MPutbackChars, PutbackChars),
-	mvar__put(MPutbackChars, [Char | PutbackChars]).
-
-%-----------------------------------------------------------------------------%
-
-:- type linenumber(S)
-	--->	line(
-			S,		% stream
-			mvar(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)) -->
-	mvar__init(MLine),
-	mvar__put(MLine, 0).
-
-linenumber_base_stream(line(Stream, _)) = Stream.
-
-:- 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) -->
-	stream__read_char(Stream, Result),
-	( { Result = ok('\n') } ->
-		mvar__take(MLine, Line),
-		mvar__put(MLine, Line + 1)
-	;
-		[]
-	).
-
-:- 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) -->
-	stream__putback_char(Stream, Char),
-	( { Char = '\n' } ->
-		mvar__take(MLine, Line),
-		mvar__put(MLine, Line - 1)
-	;
-		[]
-	).
-
-:- pred linenumber(linenumber(S)::in, int::out,
-		io__state::di, io__state::uo) is det.
-
-linenumber(line(_, MLine), Line) -->
-	mvar__take(MLine, Line),
-	mvar__put(MLine, Line).
-
-:- pred set_linenumber(linenumber(S)::in, int::in,
-		io__state::di, io__state::uo) is det.
-
-set_linenumber(line(_, MLine), Line) -->
-	mvar__take(MLine, _OldLine),
-	mvar__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) }
-	).
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
Index: stream/stream_old.m
===================================================================
RCS file: stream/stream_old.m
diff -N stream/stream_old.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ stream/stream_old.m	27 Nov 2006 04:36:48 -0000
@@ -0,0 +1,439 @@
+%-----------------------------------------------------------------------------%*
+% Copyright (C) 2000-2001, 2006 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_old.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 lowlevel interface described in lowlevel.m or
+% the impure interface described in impure.m
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module stream_old.
+
+:- 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.
+%
+
+	% The root of the stream class hierarchy
+:- typeclass stream(S) where [
+		% A human-readable name describing the current stream
+		% suitable for use in (e.g.) error messages.
+	func stream__name(S) = string
+].
+
+	% Streams from which you can read input.
+:- 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
+].
+
+	% Streams to which you can write output.
+:- 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
+].
+
+	% Streams which can be both read from and written to.
+:- typeclass stream__duplex(S)
+		<= (stream__input(S), stream__output(S)) where [].
+
+	% Stream for which characters can be put back at the start of
+	% the stream.
+:- 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
+].
+
+	% Stream with an unbounded amounts of putback.
+	% This adds no new methods, just a guarantee:
+	% there's no limit on the amount of putback except available
+	% memory, so unless you run out of heap space, the putback_char
+	% method must always succeed.
+:- typeclass stream__unbounded_putback(S) <= stream__putback(S) where [].
+
+:- 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).
+
+	% Retrieve the original stream.
+:- func putback_base_stream(putback(S)) = 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 a line-number counting stream.
+:- pred linenumber_stream(S::in, linenumber(S)::out,
+		io__state::di, io__state::uo) is det <= stream__input(S).
+
+	% Retrieve the original stream.
+:- func linenumber_base_stream(linenumber(S)) = S.
+
+%-----------------------------------------------------------------------------%
+
+% XXX If/when default type class implementations are introduced,
+% some of 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 InputS onto stream OutputS.
+	% Errors associated with stream InputS are reported through the
+	% stream__res argument.  Errors associated with stream OutputS
+	% throw a stream_error exception.
+:- pred cat(InputS::in, OutputS::in, stream__res::out,
+		io__state::di, io__state::uo) is det
+		<= (stream__input(InputS), stream__output(OutputS)).
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+	% These two imports are only so that when building a stand-alone
+	% stream library we include the following modules in the
+	% library.
+:- import_module (impure), lowlevel.
+
+:- import_module mvar.
+:- import_module int, string.
+
+
+:- type stream(S) ---> stream.
+
+:- type putback(S)
+	--->	pb(
+			S,
+			mvar(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)) -->
+	mvar__init(MPutbackChars),
+	mvar__put(MPutbackChars, []).
+
+putback_base_stream(pb(Stream, _)) = Stream.
+
+:- 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) -->
+	mvar__take(MPutbackChars, PutbackChars),
+	(
+		{ PutbackChars = [] },
+		{ NewPutbackChars = PutbackChars },
+		stream__read_char(Stream, Result)
+	;
+		{ PutbackChars = [Char | NewPutbackChars] },
+		{ Result = ok(Char) }
+	),
+	mvar__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) -->
+	mvar__take(MPutbackChars, PutbackChars),
+	mvar__put(MPutbackChars, [Char | PutbackChars]).
+
+%-----------------------------------------------------------------------------%
+
+:- type linenumber(S)
+	--->	line(
+			S,		% stream
+			mvar(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)) -->
+	mvar__init(MLine),
+	mvar__put(MLine, 0).
+
+linenumber_base_stream(line(Stream, _)) = Stream.
+
+:- 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) -->
+	stream__read_char(Stream, Result),
+	( { Result = ok('\n') } ->
+		mvar__take(MLine, Line),
+		mvar__put(MLine, Line + 1)
+	;
+		[]
+	).
+
+:- 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) -->
+	stream__putback_char(Stream, Char),
+	( { Char = '\n' } ->
+		mvar__take(MLine, Line),
+		mvar__put(MLine, Line - 1)
+	;
+		[]
+	).
+
+:- pred linenumber(linenumber(S)::in, int::out,
+		io__state::di, io__state::uo) is det.
+
+linenumber(line(_, MLine), Line) -->
+	mvar__take(MLine, Line),
+	mvar__put(MLine, Line).
+
+:- pred set_linenumber(linenumber(S)::in, int::in,
+		io__state::di, io__state::uo) is det.
+
+set_linenumber(line(_, MLine), Line) -->
+	mvar__take(MLine, _OldLine),
+	mvar__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) }
+	).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: stream/stream_util.m
===================================================================
RCS file: stream/stream_util.m
diff -N stream/stream_util.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ stream/stream_util.m	27 Nov 2006 04:55:22 -0000
@@ -0,0 +1,20 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2006 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 in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% File: stream_util.m.
+% Main authors: maclarty.
+% 
+% This library contains a set of utility streams that conform to the interface
+% defined in the stream module in the Mercury standard library.
+%
+
+:- module stream_util.
+
+:- interface.
+
+:- include_module string_builder.
Index: stream/stream_util.string_builder.m
===================================================================
RCS file: stream/stream_util.string_builder.m
diff -N stream/stream_util.string_builder.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ stream/stream_util.string_builder.m	27 Nov 2006 04:53:30 -0000
@@ -0,0 +1,88 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2006 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 in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% File: stream_util.string_builder.m.
+% Main authors: maclarty.
+% 
+% This module implements a string builder stream, that can be used to 
+% build a string by calling predicates that write to string or character
+% writer streams.
+%
+:- module stream_util.string_builder.
+
+:- interface.
+
+:- import_module char.
+:- import_module stream.
+:- import_module string.
+
+:- type string_builder_stream.
+
+:- type string_builder_state.
+
+:- pred init(string_builder_stream::out, string_builder_state::uo) is det.
+
+:- instance stream.stream(string_builder_stream, string_builder_state).
+:- instance stream.output(string_builder_stream, string_builder_state).
+
+:- instance stream.writer(string_builder_stream, string, string_builder_state).
+:- instance stream.writer(string_builder_stream, char, string_builder_state).
+
+:- func string_builder_state_to_string(string_builder_state::di) = (string::uo)
+    is det.
+
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module list.
+
+:- type string_builder_state
+    --->    string_builder_state(list(string)).
+
+:- type string_builder_stream
+    --->    string_builder_stream.
+
+init(string_builder_stream, string_builder_state([])).
+
+:- instance stream.stream(string_builder_stream, string_builder_state)
+        where [
+    name(_, "<<string builder stream>>", !State)
+].
+
+:- instance stream.output(string_builder_stream, string_builder_state)
+        where [
+    flush(_, !State)
+].
+
+:- instance stream.writer(string_builder_stream, string, string_builder_state)
+        where [
+    ( put(_, String, !State) :-
+        !.State = string_builder_state(StringList0),
+        %
+        % The string builder will never clobber the string.  Also we
+        % know that nothing else can clobber the string since it isn't unique.
+        % Therefore the inst cast below is okay, even though it is a lie.
+        %
+        StringList = [unsafe_promise_unique(String) | StringList0],
+        !:State = string_builder_state(StringList)
+    )
+].
+
+:- instance stream.writer(string_builder_stream, char, string_builder_state)
+        where [
+    ( put(_, Char, !State) :-
+        !.State = string_builder_state(StringList0),
+        StringList = [string.from_char(Char) | StringList0],
+        !:State = string_builder_state(StringList)
+    )
+].
+
+string_builder_state_to_string(State) = String :-
+    State = string_builder_state(StringList),
+    String = string.join_list("", list.reverse(StringList)).
Index: stream/tests/Makefile
===================================================================
RCS file: stream/tests/Makefile
diff -N stream/tests/Makefile
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ stream/tests/Makefile	27 Nov 2006 04:40:03 -0000
@@ -0,0 +1,20 @@
+.PHONY: runtests
+runtests: stream_util_test.runtest
+
+.PHONY: stream_util_test.runtest
+stream_util_test.runtest: stream_util_test.m Mercury.modules
+	@mmc --make stream_util_test
+	@./stream_util_test > stream_util_test.out
+	@if diff stream_util_test.out stream_util_test.exp; then 	\
+		echo PASSED TEST $@;					\
+	else								\
+		echo FAILED TEST $@;					\
+	fi
+
+Mercury.modules:
+	mmc -f ../*.m *.m
+
+realclean:
+	-rm *.out
+	mmc --make stream_util_test.realclean
+	
Index: stream/tests/stream_util_test.exp
===================================================================
RCS file: stream/tests/stream_util_test.exp
diff -N stream/tests/stream_util_test.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ stream/tests/stream_util_test.exp	27 Nov 2006 03:47:04 -0000
@@ -0,0 +1,13 @@
+Hello, world!
+<?xml version="1.0"?>
+<List functor="[|]" type="list.list(int)" arity="2">
+	<Int type="int">1</Int>
+	<List functor="[|]" type="list.list(int)" arity="2">
+		<Int type="int">2</Int>
+		<List functor="[|]" type="list.list(int)" arity="2">
+			<Int type="int">3</Int>
+			<Nil functor="[]" type="list.list(int)" arity="0" />
+		</List>
+	</List>
+</List>
+
Index: stream/tests/stream_util_test.m
===================================================================
RCS file: stream/tests/stream_util_test.m
diff -N stream/tests/stream_util_test.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ stream/tests/stream_util_test.m	27 Nov 2006 04:53:50 -0000
@@ -0,0 +1,37 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+:- module stream_util_test.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+:- import_module stream.
+:- import_module stream_util.
+:- import_module stream_util.string_builder.
+:- import_module term_to_xml.
+
+main(!IO) :-
+    some [StringBuilderStream, !StringBuilderState, String] (
+        string_builder.init(StringBuilderStream, !:StringBuilderState),
+        put(StringBuilderStream, "Hello", !StringBuilderState),
+        put(StringBuilderStream, ',', !StringBuilderState),
+        put(StringBuilderStream, " world!", !StringBuilderState),
+        String = string_builder_state_to_string(!.StringBuilderState),
+        io.write_string(String, !IO),
+        io.nl(!IO)
+    ),
+    some [StringBuilderStream, !StringBuilderState, String] (
+        string_builder.init(StringBuilderStream, !:StringBuilderState),
+        write_xml_doc_general(StringBuilderStream, [1, 2, 3],
+            simple, no_stylesheet, no_dtd, _, !StringBuilderState),
+        String = string_builder_state_to_string(!.StringBuilderState),
+        io.write_string(String, !IO),
+        io.nl(!IO)
+    ).
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list