[m-rev.] for review: move string builder stream to standard library
Ian MacLarty
maclarty at csse.unimelb.edu.au
Thu Apr 19 16:59:30 AEST 2007
For review by anyone.
Estimated hours taken: 0.5
Branches: main.
Move the string builder stream from extras to the standard library.
library/string.builder.m:
Move stream_util.string_builder to string.builder.
Use builtin.copy instead of unsafe_promise_unique in the implementation
of put/4 for the string builder stream.
library/string.m:
Include string.builder.
tests/hard_coded/Mmakefile:
tests/hard_coded/string_builder_test.exp:
tests/hard_coded/string_builder_test.m:
Add a test case.
extras/Mmakefile:
extras/README:
extras/stream/Mmakefile:
extras/stream/README:
extras/stream/impure.m:
extras/stream/lowlevel.m:
extras/stream/stream_old.m:
extras/stream/stream_util.m:
extras/stream/stream_util.string_builder.m:
extras/stream/tests/Makefile:
extras/stream/tests/stream_util_test.exp:
extras/stream/tests/stream_util_test.m:
Completely remove the streams modules from extras. These modules
are all deprecated now.
Index: library/string.builder.m
===================================================================
RCS file: library/string.builder.m
diff -N library/string.builder.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ library/string.builder.m 19 Apr 2007 05:14:15 -0000
@@ -0,0 +1,92 @@
+%-----------------------------------------------------------------------------%
+% 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: string.builder.m.
+% Main author: maclarty.
+%
+% This module implements a string builder stream. It can be used to
+% build up a string using string or character writers.
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module string.builder.
+:- interface.
+
+:- import_module char.
+:- import_module stream.
+
+%-----------------------------------------------------------------------------%
+
+:- 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),
+ copy(String, UniqueString),
+ StringList = [UniqueString | 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)).
+
+%-----------------------------------------------------------------------------%
+:- end_module string.builder.
+%-----------------------------------------------------------------------------%
Index: library/string.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/string.m,v
retrieving revision 1.257
diff -u -r1.257 string.m
--- library/string.m 18 Mar 2007 23:35:00 -0000 1.257
+++ library/string.m 19 Apr 2007 03:58:11 -0000
@@ -31,6 +31,8 @@
:- module string.
:- interface.
+:- include_module builder.
+
:- import_module assoc_list.
:- import_module char.
:- import_module deconstruct.
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.314
diff -u -r1.314 Mmakefile
--- tests/hard_coded/Mmakefile 5 Apr 2007 02:52:47 -0000 1.314
+++ tests/hard_coded/Mmakefile 19 Apr 2007 04:18:11 -0000
@@ -196,6 +196,7 @@
stream_test \
string_alignment \
string_alignment_bug \
+ string_builder_test \
string_loop \
string_split \
string_string \
Index: tests/hard_coded/string_builder_test.exp
===================================================================
RCS file: tests/hard_coded/string_builder_test.exp
diff -N tests/hard_coded/string_builder_test.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/string_builder_test.exp 19 Apr 2007 04:15:10 -0000
@@ -0,0 +1,18 @@
+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>
+
+[
+ 4,
+ 5,
+ 6]
+3.14
Index: tests/hard_coded/string_builder_test.m
===================================================================
RCS file: tests/hard_coded/string_builder_test.m
diff -N tests/hard_coded/string_builder_test.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/string_builder_test.m 19 Apr 2007 04:17:19 -0000
@@ -0,0 +1,38 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+:- module string_builder_test.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+:- import_module pprint.
+:- import_module stream.
+:- import_module stream.string_writer.
+:- import_module string.builder.
+:- import_module term_to_xml.
+
+main(!IO) :-
+ some [!State] (
+ string.builder.init(Stream, !:State),
+ put(Stream, "Hello", !State),
+ put(Stream, ',', !State),
+ put(Stream, " world!", !State),
+ put(Stream, "\n", !State),
+ write_xml_doc_general(Stream, [1, 2, 3],
+ simple, no_stylesheet, no_dtd, _, !State),
+ put(Stream, "\n", !State),
+ pprint.write(Stream, 0, to_doc([4, 5, 6]),
+ !State),
+ put(Stream, "\n", !State),
+ string_writer.format(Stream, "%.2f", [f(3.14)], !State),
+ put(Stream, "\n", !State),
+ String = string_builder_state_to_string(!.State),
+ io.write_string(String, !IO)
+ ).
Index: extras/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/Mmakefile,v
retrieving revision 1.3
diff -u -r1.3 Mmakefile
--- extras/Mmakefile 26 Oct 2005 05:04:14 -0000 1.3
+++ extras/Mmakefile 19 Apr 2007 04:08:35 -0000
@@ -21,8 +21,6 @@
# logged_output requires a specially-configured Mercury installation
# odbc requires an ODBC driver be installed
# quickcheck no `install' target
-# stream no `install' target; also has some modules shared with
-# the `concurrency' package.
SUBDIRS = cgi complex_numbers curs curses dynamic_linking \
lazy_evaluation lex moose posix \
Index: extras/README
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/README,v
retrieving revision 1.23
diff -u -r1.23 README
--- extras/README 5 Dec 2006 03:12:03 -0000 1.23
+++ extras/README 19 Apr 2007 04:08:53 -0000
@@ -82,13 +82,6 @@
adapted to make them suitable for use with solver
types.
-stream Utility streams that use the stream interface in the
- standard library.
-
- This directory also contains an old version of generate IO
- streams, which has now been superceded by the stream.m module
- in the standard library.
-
trailed_update Some library modules that make use of backtrackable
destructive update, including a module which provides
some support for Prolog-style unification constraints.
Index: extras/stream/Mmakefile
===================================================================
RCS file: extras/stream/Mmakefile
diff -N extras/stream/Mmakefile
--- extras/stream/Mmakefile 5 Dec 2006 03:12:03 -0000 1.3
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,24 +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 in the Mercury distribution.
-#-----------------------------------------------------------------------------#
-
--include ../Mmake.params
-
-MAIN_TARGET=libstream_util
-
-depend: stream_util.depend
-
-.PHONY: old_stream
-old_stream: mvar.m semaphore.m
- mmake stream_old.depend
- mmake libstream_old
-
-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
Index: extras/stream/README
===================================================================
RCS file: extras/stream/README
diff -N extras/stream/README
--- extras/stream/README 5 Dec 2006 03:12:03 -0000 1.3
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,25 +0,0 @@
-This directory contains various instances of the stream typeclass defined
-in the Mercury standard library. The instances implement various utility
-streams.
-
-stream_util.m:
- The top-level package.
-
-stream_util.string_builder.m:
- An output stream that can be used to build up strings from predicates
- that write to any string or character streams.
-
-tests/:
- Some test cases. To run the tests, change to this directory and
- type "make".
-
-lowlevel.m:
-impure.m:
-stream_old.m:
- These files are part of the old stream interface, which has now been
- deprecated.
-
- Similar functionality is available in the standard library's
- stream module.
-
- To build the stream_old library do "mmake old_stream".
Index: extras/stream/impure.m
===================================================================
RCS file: extras/stream/impure.m
diff -N extras/stream/impure.m
--- extras/stream/impure.m 5 Dec 2006 03:12:04 -0000 1.4
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,136 +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: impure.m.
-% Main author: petdr
-% Stability: exceptionally low.
-%
-% An impure interface for describing streams. You may want to also look
-% at the pure lowlevel interface in `lowlevel.m'.
-%
-% 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_old.
-:- import_module char.
-:- import_module io.
-
- % 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.
- 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_old.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 mvar.
-:- import_module exception, unit.
-
-:- type impure(S)
- ---> impure(
- S, % Handle
- mvar(unit) % Mvar used as a semaphore to
- % ensure the atomicity of
- % operations.
- ).
-
-impure_init(S, impure(S, MVar)) -->
- mvar__init(MVar),
- mvar__put(MVar, unit).
-
-:- pragma promise_pure(pure_read_char/4).
-pure_read_char(impure(Stream, MVar), Result, IO0, IO) :-
- mvar__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)
- )
- ),
- mvar__put(MVar, Unit, IO1, IO).
-
-%-----------------------------------------------------------------------------%
-
-:- pragma promise_pure(pure_write_char/4).
-pure_write_char(impure(Stream, MVar), Chr, IO0, IO) :-
- mvar__take(MVar, Unit, IO0, IO1),
- ( impure impure__write_char(Stream, Chr) ->
- mvar__put(MVar, Unit, IO1, IO)
- ;
- ( impure impure__get_error(Stream, Err0) ->
- Err = Err0
- ;
- Err = "write char failed but there is no error message"
- ),
- mvar__put(MVar, Unit, IO1, IO),
- throw(stream_error(Err))
- ).
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
Index: extras/stream/lowlevel.m
===================================================================
RCS file: extras/stream/lowlevel.m
diff -N extras/stream/lowlevel.m
--- extras/stream/lowlevel.m 5 Dec 2006 03:12:04 -0000 1.4
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,147 +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: lowlevel.m.
-% Main author: petdr
-% Stability: exceptionally low.
-%
-% A lowlevel pure interface for describing streams. You may also want
-% to look at the impure lowlevel interface in `impure.m'.
-%
-% This file provides a typeclass for people who want to map streams
-% to a foreign language binding while doing the minimizing the amount of
-% work. In particular you need to write much less foreign language
-% code, since you only need to implement a few predicates with a well
-% defined interface.
-%
-% This file provides throwing exceptions, grabbing error messages and
-% packaging results into ok/error/eof.
-%
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-
-:- module lowlevel.
-
-:- interface.
-
-:- import_module stream_old.
-:- import_module bool, char, io.
-
- % A handle on the lowlevel stream.
-:- type lowlevel(S).
-
-:- typeclass lowlevel(S) where [
- % Did an error occur processing the stream?
- % This predicate must also clear the error status of a
- % stream after reporting the error.
- % The bool indicates whether there was an error. If the
- % bool is yes, then the string returned holds the error
- % message.
- pred get_error(S::in, string::out, bool::out,
- io__state::di, io__state::uo) is det
-].
-
-:- typeclass lowlevel__input(S) <= lowlevel(S) where [
- % Attempt to read one character from the stream
- % described by S.
- % The bool indicates whether the character was
- % successfully read.
- pred read_char(S::in, char::out, bool::out,
- io__state::di, io__state::uo) is det,
-
- % The bool will be yes iff S is at the end-of-file (eof).
- pred is_eof(S::in, bool::out, io__state::di, io__state::uo) is det
-].
-
-:- typeclass output(S) <= lowlevel(S) where [
- % Attempt to write one character to the current stream.
- % The bool indicates whether the character was
- % successfully written.
- pred write_char(S::in, char::in, bool::out,
- io__state::di, io__state::uo) is det
-].
-
-:- pred init(S::in, lowlevel(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 low_read_char(lowlevel(S), stream_old.result(char),
- io__state, io__state) <= lowlevel__input(S).
-:- mode low_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 low_write_char(lowlevel(S), char,
- io__state, io__state) <= lowlevel__output(S).
-:- mode low_write_char(in, in, di, uo) is det.
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-
-:- implementation.
-
-:- import_module mvar.
-:- import_module exception, unit.
-
-:- type lowlevel(S)
- ---> lowlevel(
- S, % Handle
- mvar(unit) % Mvar used as a semaphore to
- % ensure the atomicity of
- % operations.
- ).
-
-init(S, lowlevel(S, MVar)) -->
- mvar__init(MVar),
- mvar__put(MVar, unit).
-
-low_read_char(lowlevel(Stream, MVar), Result) -->
- mvar__take(MVar, Unit),
- read_char(Stream, Chr, ReadBool),
- ( { ReadBool = yes } ->
- { Result = ok(Chr) }
- ;
- get_error(Stream, Error, ErrorBool),
- ( { ErrorBool = yes } ->
- { Result = error(Error) }
- ;
- is_eof(Stream, EofBool),
- ( { EofBool = yes } ->
- { Result = eof }
- ;
- { ErrorStr = "read char failed for an unknown reason" },
- { Result = error(ErrorStr) }
- )
- )
- ),
- mvar__put(MVar, Unit).
-
-%-----------------------------------------------------------------------------%
-
-low_write_char(lowlevel(Stream, MVar), Chr) -->
- mvar__take(MVar, Unit),
- write_char(Stream, Chr, WriteBool),
- ( { WriteBool = yes } ->
- mvar__put(MVar, Unit)
- ;
- get_error(Stream, Err0, ErrorBool),
- { ErrorBool = yes ->
- Err = Err0
- ;
- Err = "write char failed but there is no error message"
- },
- mvar__put(MVar, Unit),
- { throw(stream_error(Err)) }
- ).
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
Index: extras/stream/stream_old.m
===================================================================
RCS file: extras/stream/stream_old.m
diff -N extras/stream/stream_old.m
--- extras/stream/stream_old.m 5 Dec 2006 03:12:05 -0000 1.1
+++ /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_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_old.result(T)
- ---> ok(T)
- ; eof
- ; error(string)
- .
-
-:- type stream_old.result
- ---> ok
- ; eof
- ; error(string)
- .
-
-:- type stream_old.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_old.name(S) = string
-].
-
- % Streams from which you can read input.
-:- typeclass stream_old.input(S) <= stream(S) where [
- % Read one character from the stream S.
- % Errors are reported via the stream_old.result type.
- pred stream_old.read_char(S::in, stream_old.result(char)::out,
- io__state::di, io__state::uo) is det
-].
-
- % Streams to which you can write output.
-:- typeclass stream_old.output(S) <= stream(S) where [
- % Write one character to the stream S.
- % Throws a stream_error exception if a problem occurs.
- pred stream_old.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_old.duplex(S)
- <= (stream_old.input(S), stream_old.output(S)) where [].
-
- % Stream for which characters can be put back at the start of
- % the stream.
-:- typeclass stream_old.putback(S) <= stream_old.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_old.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_old.unbounded_putback(S) <= stream_old.putback(S) where [].
-
-:- typeclass stream_old.line(S) <= stream_old.input(S) where [
- % Return the line number of the input stream.
- % Lines are numbered starting from one.
- pred stream_old.line_number(S::in, int::out,
- io__state::di, io__state::uo) is det,
-
- % Set the line number of the input stream.
- pred stream_old.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_old.input(putback(S)) <= stream_old.input(S).
-:- instance stream_old.putback(putback(S)) <= stream_old.input(S).
-
- % Create the putback stream.
-:- pred putback_stream(S::in, putback(S)::out,
- io__state::di, io__state::uo) is det <= stream_old.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_old.input(linenumber(S)) <= stream_old.input(S).
-:- instance stream_old.putback(linenumber(S)) <= stream_old.putback(S).
-:- instance stream_old.line(linenumber(S)) <= stream_old.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_old.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_old.read_line(S::in, stream_old.result(list(char))::out,
- io__state::di, io__state::uo) is det <= stream_old.input(S).
-
-%-----------------------------------------------------------------------------%
-
-% Predicates which require an input stream with putback.
-
- % Reads a whitespace delimited word from the current input stream.
-:- pred stream_old.read_word(S::in, stream_old.result(list(char))::out,
- io__state::di, io__state::uo) is det <= stream_old.putback(S).
-
- % Discards all the whitespace from the input stream.
-:- pred stream_old.ignore_whitespace(S::in, stream_old.result::out,
- io__state::di, io__state::uo) is det <= stream_old.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_old.write_string(S::in, string::in,
- io__state::di, io__state::uo) is det <= stream_old.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_old.res argument. Errors associated with stream OutputS
- % throw a stream_error exception.
-:- pred cat(InputS::in, OutputS::in, stream_old.res::out,
- io__state::di, io__state::uo) is det
- <= (stream_old.input(InputS), stream_old.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_old.name(pb(S, _)) = stream_old.name(S))
-].
-
-:- instance stream_old.input(putback(S)) <= stream_old.input(S) where [
- pred(stream_old.read_char/4) is putback_read_char
-].
-
-:- instance stream_old.putback(putback(S)) <= stream_old.input(S) where [
- pred(stream_old.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_old.result(char)::out,
- io__state::di, io__state::uo) is det <= stream_old.input(S).
-
-putback_read_char(pb(Stream, MPutbackChars), Result) -->
- mvar__take(MPutbackChars, PutbackChars),
- (
- { PutbackChars = [] },
- { NewPutbackChars = PutbackChars },
- stream_old.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_old.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_old.name(line(S, _)) = stream_old.name(S))
-].
-
-:- instance stream_old.input(linenumber(S)) <= stream_old.input(S) where [
- pred(stream_old.read_char/4) is linenumber_read_char
-].
-
-:- instance stream_old.putback(linenumber(S)) <= stream_old.putback(S) where [
- pred(stream_old.putback_char/4) is linenumber_putback_char
-].
-
-:- instance stream_old.line(linenumber(S)) <= stream_old.input(S) where [
- pred(stream_old.line_number/4) is linenumber,
- pred(stream_old.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_old.result(char)::out,
- io__state::di, io__state::uo) is det <= stream_old.input(S).
-
-linenumber_read_char(line(Stream, MLine), Result) -->
- stream_old.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_old.putback(S).
-
-linenumber_putback_char(line(Stream, MLine), Char) -->
- stream_old.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_old.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_old.result(list(char))::out,
- io__state::di, io__state::uo) is det <= stream_old.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_old.read_char(In, Res),
- (
- { Res = ok(Char) },
- stream_old.write_char(Out, Char),
- cat(In, Out, Result)
- ;
- { Res = eof },
- { Result = ok }
- ;
- { Res = error(Error) },
- { Result = error(Error) }
- ).
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
Index: extras/stream/stream_util.m
===================================================================
RCS file: extras/stream/stream_util.m
diff -N extras/stream/stream_util.m
--- extras/stream/stream_util.m 5 Dec 2006 03:12:05 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,21 +0,0 @@
-%-----------------------------------------------------------------------------%
-% 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 author: maclarty.
-%
-% This library contains a set of utility streams that conform to the interface
-% defined in the stream module in the Mercury standard library as well
-% as generic predicates that operate on streams.
-%
-
-:- module stream_util.
-
-:- interface.
-
-:- include_module string_builder.
Index: extras/stream/stream_util.string_builder.m
===================================================================
RCS file: extras/stream/stream_util.string_builder.m
diff -N extras/stream/stream_util.string_builder.m
--- extras/stream/stream_util.string_builder.m 29 Mar 2007 06:08:05 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,87 +0,0 @@
-%-----------------------------------------------------------------------------%
-% vim: ft=mercury ts=4 sw=4 et
-%-----------------------------------------------------------------------------%
-% Copyright (C) 2006-2007 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 author: maclarty.
-%
-% This module implements a string builder stream. It can be used to
-% build up a string using string or character writers.
-%
-:- 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.append_list(list.reverse(StringList)).
Index: extras/stream/tests/Makefile
===================================================================
RCS file: extras/stream/tests/Makefile
diff -N extras/stream/tests/Makefile
--- extras/stream/tests/Makefile 5 Dec 2006 03:12:06 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,20 +0,0 @@
-.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: extras/stream/tests/stream_util_test.exp
===================================================================
RCS file: extras/stream/tests/stream_util_test.exp
diff -N extras/stream/tests/stream_util_test.exp
--- extras/stream/tests/stream_util_test.exp 5 Dec 2006 03:12:07 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,18 +0,0 @@
-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>
-
-[
- 4,
- 5,
- 6]
-3.14
Index: extras/stream/tests/stream_util_test.m
===================================================================
RCS file: extras/stream/tests/stream_util_test.m
diff -N extras/stream/tests/stream_util_test.m
--- extras/stream/tests/stream_util_test.m 2 Apr 2007 04:33:58 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,40 +0,0 @@
-%-----------------------------------------------------------------------------%
-% 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 pprint.
-:- import_module stream.
-:- import_module stream.string_writer.
-:- import_module stream_util.
-:- import_module stream_util.string_builder.
-:- import_module string.
-:- import_module term_to_xml.
-
-main(!IO) :-
- some [!State] (
- string_builder.init(Stream, !:State),
- put(Stream, "Hello", !State),
- put(Stream, ',', !State),
- put(Stream, " world!", !State),
- put(Stream, "\n", !State),
- write_xml_doc_general(Stream, [1, 2, 3],
- simple, no_stylesheet, no_dtd, _, !State),
- put(Stream, "\n", !State),
- pprint.write(Stream, 0, to_doc([4, 5, 6]),
- !State),
- put(Stream, "\n", !State),
- string_writer.format(Stream, "%.2f", [f(3.14)], !State),
- put(Stream, "\n", !State),
- String = string_builder_state_to_string(!.State),
- io.write_string(String, !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