[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