[MLton] cvs commit: imperative instream improvements
Stephen Weeks
sweeks@mlton.org
Mon, 12 Jan 2004 10:00:22 -0800
sweeks 04/01/12 10:00:22
Modified: basis-library/io bin-io.sig bin-io.sml imperative-io.fun
imperative-io.sig stream-io.fun stream-io.sig
text-io.sml
basis-library/libs build
Removed: basis-library/io bin-or-text-io.fun buffer-i.fun
buffer-i.sig fast-imperative-io.fun
fast-imperative-io.sig
Log:
MAIL imperative instream improvements
Improved the implementation of imperative instreams, based on Henry's
suggestion:
In general I would think that this could all be in a single
interface which always looks at a count and, if there is room, it
just extracts the character. All other cases would have the count
set so that it looks like not enough room, and then the slow code
can do what ever (including EOF, etc.)
This amounted to changing the datatypes from
datatype state = Open of {eos: bool} | Closed
datatype inbuffer = In of {reader: PIO.reader,
augmented_reader: PIO.reader,
state: state ref,
first: int ref,
last: int ref,
buf: A.array}
datatype instream' = Buffer of BI.inbuffer
| Stream of StreamIO.instream
datatype instream = In of instream' ref
to
datatype state =
Closed
| Open of {eos: bool}
| Stream of StreamIO.instream
datatype instream = In of {augmentedReader: PIO.reader,
buf: A.array,
first: int ref,
last: int ref,
reader: PIO.reader,
state: state ref}
So, the sum type (Bufer | Stream) on the outside was moved to the
inside into state. All the operations that used to test on whether
the instream was Buffer or Stream, now assume it's a Buffer, and will
only do further tests if !first = !last.
I also moved around the files and cleaned up a lot. I eliminated the
BufferI and FastImperativeIO functors, folding everything into
ImperativeIO, which replaced the old version that did everything using
streams.
Revision Changes Path
1.9 +2 -3 mlton/basis-library/io/bin-io.sig
Index: bin-io.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/bin-io.sig,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- bin-io.sig 2 May 2003 23:49:46 -0000 1.8
+++ bin-io.sig 12 Jan 2004 18:00:21 -0000 1.9
@@ -38,12 +38,11 @@
val equalsIn: instream * instream -> bool
val equalsOut: outstream * outstream -> bool
+ val inFd: instream -> Posix.IO.file_desc
val newIn: Posix.IO.file_desc * string -> instream
val newOut: Posix.IO.file_desc * string -> outstream
- val inFd: instream -> Posix.IO.file_desc
val outFd: outstream -> Posix.IO.file_desc
-
- val stdIn: instream
val stdErr: outstream
+ val stdIn: instream
val stdOut: outstream
end
1.12 +17 -32 mlton/basis-library/io/bin-io.sml
Index: bin-io.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/bin-io.sml,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- bin-io.sml 21 Nov 2003 21:47:52 -0000 1.11
+++ bin-io.sml 12 Jan 2004 18:00:21 -0000 1.12
@@ -1,33 +1,18 @@
structure BinIO: BIN_IO_EXTRA =
- struct
- structure S = struct
- structure PrimIO = BinPrimIO
- structure Vector = Word8Vector
- structure VectorSlice = Word8VectorSlice
- structure Array = Word8Array
- structure ArraySlice = Word8ArraySlice
- val someElem = (0wx0: Word8.word)
- val line = NONE
- val xlatePos = SOME {fromInt = fn i => i,
- toInt = fn i => i}
- structure Cleaner = Cleaner
- end
- structure StreamIO = StreamIOExtraFile (open S)
- structure SIO = StreamIO
- structure S = struct
- open S
- structure StreamIO = StreamIO
- end
- structure BufferI = BufferIExtraFile (open S)
- structure BI = BufferI
- structure S = struct
- open S
- structure BufferI = BufferI
- val chunkSize = Primitive.TextIO.bufSize
- val fileTypeFlags = [PosixPrimitive.FileSys.O.binary]
- val mkReader = Posix.IO.mkBinReader
- val mkWriter = Posix.IO.mkBinWriter
- end
- structure FastImperativeIO = FastImperativeIOExtraFile (open S)
- open FastImperativeIO
- end
+ ImperativeIO (structure Array = Word8Array
+ structure ArraySlice = Word8ArraySlice
+ structure Cleaner = Cleaner
+ structure PrimIO = BinPrimIO
+ structure Vector = Word8Vector
+ structure VectorSlice = Word8VectorSlice
+
+ val chunkSize = Primitive.TextIO.bufSize
+ val fileTypeFlags = [PosixPrimitive.FileSys.O.binary]
+ val line = NONE
+ val mkReader = Posix.IO.mkBinReader
+ val mkWriter = Posix.IO.mkBinWriter
+ val someElem = (0wx0: Word8.word)
+ val xlatePos = SOME {fromInt = fn i => i,
+ toInt = fn i => i})
+
+
1.12 +717 -269 mlton/basis-library/io/imperative-io.fun
Index: imperative-io.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/imperative-io.fun,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- imperative-io.fun 4 Jan 2004 05:40:08 -0000 1.11
+++ imperative-io.fun 12 Jan 2004 18:00:21 -0000 1.12
@@ -1,287 +1,735 @@
-signature IMPERATIVE_IO_EXTRA_ARG =
+signature IMPERATIVE_IO_ARG =
sig
- structure StreamIO: STREAM_IO_EXTRA
- structure Vector: MONO_VECTOR
- structure Array: MONO_ARRAY
- sharing type StreamIO.elem = Vector.elem = Array.elem
- sharing type StreamIO.vector = Vector.vector = Array.vector
- end
-
-functor ImperativeIOExtra
- (S: IMPERATIVE_IO_EXTRA_ARG) :>
- IMPERATIVE_IO_EXTRA where type elem = S.StreamIO.elem
- where type vector = S.StreamIO.vector
- where type vector_slice = S.StreamIO.vector_slice
- where type StreamIO.instream = S.StreamIO.instream
- where type StreamIO.outstream = S.StreamIO.outstream
- where type StreamIO.out_pos = S.StreamIO.out_pos
- where type StreamIO.reader = S.StreamIO.reader
- where type StreamIO.writer = S.StreamIO.writer
- where type StreamIO.pos = S.StreamIO.pos =
- struct
- open S
-
- structure SIO = StreamIO
- structure V = Vector
- structure A = Array
-
- type elem = SIO.elem
- type vector = SIO.vector
- type vector_slice = SIO.vector_slice
-
- (*---------------*)
- (* outstream *)
- (*---------------*)
-
- datatype outstream = Out of SIO.outstream ref
-
- fun equalsOut (Out os1, Out os2) = os1 = os2
-
- fun output (Out os, v) = SIO.output (!os, v)
- fun output1 (Out os, v) = SIO.output1 (!os, v)
- fun outputSlice (Out os, v) = SIO.outputSlice (!os, v)
- fun flushOut (Out os) = SIO.flushOut (!os)
- fun closeOut (Out os) = SIO.closeOut (!os)
- fun mkOutstream os = Out (ref os)
- fun getOutstream (Out os) = !os
- fun setOutstream (Out os, os') = os := os'
- fun getPosOut (Out os) = SIO.getPosOut (!os)
- fun setPosOut (Out os, out_pos) = os := SIO.setPosOut out_pos
-
- (*---------------*)
- (* instream *)
- (*---------------*)
-
- datatype instream = In of SIO.instream ref
-
- fun equalsIn (In is1, In is2) = is1 = is2
-
- fun input (In is) = let val (v, is') = SIO.input (!is)
- in is := is'; v
- end
- (* input1 will never move past a temporary end of stream *)
- fun input1 (In is) =
- case SIO.input1 (!is) of
- SOME (c,is') => (is := is'; SOME c)
- | NONE => NONE
- (* input1 will move past a temporary end of stream *)
- fun input1 (In is) =
- case SIO.input1' (!is) of
- (c,is') => (is := is'; c)
- fun inputN (In is, n) = let val (v, is') = SIO.inputN (!is, n)
- in is := is'; v
- end
- fun inputAll (In is) = let val (v, is') = SIO.inputAll (!is)
- in is := is'; v
- end
- fun inputLine (In is) =
- Option.map (fn (v, is') => (is := is'; v)) (SIO.inputLine (!is))
-
- fun canInput (In is, n) = SIO.canInput (!is, n)
- fun lookahead (In is) = Option.map (fn (c, is') => c) (SIO.input1 (!is))
- fun closeIn (In is) = SIO.closeIn (!is)
- fun endOfStream (In is) = SIO.endOfStream (!is)
- fun mkInstream is = In (ref is)
- fun getInstream (In is) = !is
- fun setInstream (In is, is') = is := is'
-
- fun openVector v = mkInstream (SIO.openVector v)
-
- fun scanStream f is =
- case f SIO.input1 (getInstream is) of
- NONE => NONE
- | SOME (v, is') => (setInstream (is, is'); SOME v)
- end
-
-signature IMPERATIVE_IO_ARG =
- sig
- structure StreamIO: STREAM_IO
- structure Vector: MONO_VECTOR
- structure Array: MONO_ARRAY
- sharing type StreamIO.elem = Vector.elem = Array.elem
- sharing type StreamIO.vector = Vector.vector = Array.vector
- end
-
-functor ImperativeIO
- (S: IMPERATIVE_IO_ARG) :>
- IMPERATIVE_IO where type elem = S.StreamIO.elem
- where type vector = S.StreamIO.vector
- where type StreamIO.instream = S.StreamIO.instream
- where type StreamIO.outstream = S.StreamIO.outstream
- where type StreamIO.out_pos = S.StreamIO.out_pos
- where type StreamIO.reader = S.StreamIO.reader
- where type StreamIO.writer = S.StreamIO.writer
- where type StreamIO.pos = S.StreamIO.pos =
- ImperativeIOExtra(open S
- structure StreamIO =
- struct
- open StreamIO
- type vector_slice = unit
- structure Close =
- struct
- type t = unit
-
- fun close _ = raise Fail "<Close.close>"
- fun equalsInstream _ = raise Fail "<Close.equalsInstream"
- fun make _ = raise Fail "<Close.make>"
- end
- fun instreamUniq _ = raise Fail "<instreamUniq>"
- fun input1' _ = raise (Fail "<input1'>")
- fun equalsIn _ = raise (Fail "<equalsIn>")
- fun instreamReader _ = raise (Fail "<instreamReader>")
- fun mkInstream' _ = raise (Fail "<mkInstream>")
- fun equalsOut _ = raise (Fail "<equalsOut>")
- fun outstreamWriter _ = raise (Fail "<outstreamWriter>")
- fun mkOutstream' _ = raise (Fail "<mkOutstream>")
- fun openVector _ = raise (Fail "<openVector>")
- fun inputLine _ = raise (Fail "<inputLine>")
- fun outputSlice _ = raise (Fail "<outputSlice>")
- end)
-
-signature IMPERATIVE_IO_EXTRA_FILE_ARG =
- sig
- structure StreamIO: STREAM_IO_EXTRA_FILE
- structure Vector: MONO_VECTOR
- structure Array: MONO_ARRAY
- sharing type StreamIO.elem = Vector.elem = Array.elem
- sharing type StreamIO.vector = Vector.vector = Array.vector
+ structure PrimIO: PRIM_IO
+ structure Array: sig
+ include MONO_ARRAY
+ val rawArray: int -> array
+ end
+ structure ArraySlice: MONO_ARRAY_SLICE
+ structure Vector: sig
+ include MONO_VECTOR
+ val fromArray: Array.array -> vector
+ end
+ structure VectorSlice: MONO_VECTOR_SLICE
+ sharing type PrimIO.elem
+ = Vector.elem = VectorSlice.elem
+ = Array.elem = ArraySlice.elem
+ sharing type PrimIO.vector
+ = Vector.vector = VectorSlice.vector
+ = Array.vector = ArraySlice.vector
+ sharing type PrimIO.vector_slice
+ = VectorSlice.slice = ArraySlice.vector_slice
+ sharing type PrimIO.array = Array.array = ArraySlice.array
+ sharing type PrimIO.array_slice = ArraySlice.slice
+
+ structure Cleaner: CLEANER
val chunkSize: int
val fileTypeFlags: Posix.FileSys.O.flags list
+ val line : {isLine: Vector.elem -> bool,
+ lineElem: Vector.elem} option
val mkReader: {fd: Posix.FileSys.file_desc,
name: string,
- initBlkMode: bool} -> StreamIO.reader
+ initBlkMode: bool} -> PrimIO.reader
val mkWriter: {fd: Posix.FileSys.file_desc,
name: string,
appendMode: bool,
initBlkMode: bool,
- chunkSize: int} -> StreamIO.writer
+ chunkSize: int} -> PrimIO.writer
+ val someElem: PrimIO.elem
+ val xlatePos : {toInt : PrimIO.pos -> Position.int,
+ fromInt : Position.int -> PrimIO.pos} option
end
-functor ImperativeIOExtraFile
- (S: IMPERATIVE_IO_EXTRA_FILE_ARG) :>
- IMPERATIVE_IO_EXTRA_FILE where type elem = S.StreamIO.elem
- where type vector = S.StreamIO.vector
- where type vector_slice = S.StreamIO.vector_slice
- where type StreamIO.instream = S.StreamIO.instream
- where type StreamIO.outstream = S.StreamIO.outstream
- where type StreamIO.out_pos = S.StreamIO.out_pos
- where type StreamIO.reader = S.StreamIO.reader
- where type StreamIO.writer = S.StreamIO.writer
- where type StreamIO.pos = S.StreamIO.pos =
- struct
- structure ImperativeIO = ImperativeIOExtra(open S)
- open ImperativeIO
- open S
- structure SIO = StreamIO
- structure V = Vector
-
- structure PIO = Posix.IO
- structure PFS = Posix.FileSys
-
- fun liftExn name function cause = raise IO.Io {name = name,
- function = function,
- cause = cause}
-
- (*---------------*)
- (* outstream *)
- (*---------------*)
-
- fun newOut {fd, name, appendMode,
- buffer_mode, atExit} =
- let
- val writer = mkWriter {fd = fd, name = name,
- appendMode = appendMode,
- initBlkMode = true,
- chunkSize = chunkSize}
- val outstream = SIO.mkOutstream'' {writer = writer,
- closed = false,
- buffer_mode = buffer_mode,
- atExit = atExit}
- in
- mkOutstream outstream
- end
- val stdErr = newOut {fd = PFS.stderr,
- name = "<stderr>",
- appendMode = true,
- buffer_mode = IO.NO_BUF,
- atExit = {close = false}}
- val newOut = fn {fd, name, appendMode, atExit} =>
- newOut {fd = fd, name = name, appendMode = appendMode,
- buffer_mode = if Posix.ProcEnv.isatty fd
- then IO.LINE_BUF
- else IO.BLOCK_BUF,
- atExit = atExit}
- val stdOut = newOut {fd = PFS.stdout,
- name = "<stdout>",
- appendMode = true,
- atExit = {close = false}}
- val newOut = fn {fd, name, appendMode} =>
- newOut {fd = fd, name = name, appendMode = appendMode,
- atExit = {close = true}}
- local
- val readWrite =
- let open PFS.S
- in flags [irusr, iwusr, irgrp, iwgrp, iroth, iwoth]
- end
+functor ImperativeIO (S: IMPERATIVE_IO_ARG): IMPERATIVE_IO_EXTRA =
+struct
+
+open S
+
+structure StreamIO = StreamIOExtraFile (S)
+
+structure PIO = PrimIO
+structure SIO = StreamIO
+structure A = Array
+structure AS = ArraySlice
+structure V = Vector
+structure VS = VectorSlice
+
+type elem = PrimIO.elem
+type pos = PIO.pos
+type reader = PIO.reader
+type vector = PrimIO.vector
+type vector_slice = VS.slice
+
+(* ------------------------------------------------- *)
+(* outstream *)
+(* ------------------------------------------------- *)
+
+datatype outstream = Out of SIO.outstream ref
+
+fun equalsOut (Out os1, Out os2) = os1 = os2
+
+fun output (Out os, v) = SIO.output (!os, v)
+fun output1 (Out os, v) = SIO.output1 (!os, v)
+fun outputSlice (Out os, v) = SIO.outputSlice (!os, v)
+fun flushOut (Out os) = SIO.flushOut (!os)
+fun closeOut (Out os) = SIO.closeOut (!os)
+fun mkOutstream os = Out (ref os)
+fun getOutstream (Out os) = !os
+fun setOutstream (Out os, os') = os := os'
+fun getPosOut (Out os) = SIO.getPosOut (!os)
+fun setPosOut (Out os, outPos) = os := SIO.setPosOut outPos
+
+fun newOut {appendMode, bufferMode, closeAtExit, fd, name} =
+ let
+ val writer = mkWriter {appendMode = appendMode,
+ chunkSize = chunkSize,
+ fd = fd,
+ initBlkMode = true,
+ name = name}
+ val outstream = SIO.mkOutstream'' {bufferMode = bufferMode,
+ closeAtExit = closeAtExit,
+ closed = false,
+ writer = writer}
+ in
+ mkOutstream outstream
+ end
+
+structure PFS = Posix.FileSys
+
+val stdErr = newOut {appendMode = true,
+ bufferMode = IO.NO_BUF,
+ closeAtExit = false,
+ fd = PFS.stderr,
+ name = "<stderr>"}
+
+val newOut = fn {appendMode, closeAtExit, fd, name} =>
+ newOut {appendMode = appendMode,
+ bufferMode = if Posix.ProcEnv.isatty fd
+ then IO.LINE_BUF
+ else IO.BLOCK_BUF,
+ closeAtExit = closeAtExit,
+ fd = fd,
+ name = name}
+
+val stdOut = newOut {appendMode = true,
+ closeAtExit = false,
+ fd = PFS.stdout,
+ name = "<stdout>"}
+
+val newOut = fn {appendMode, fd, name} =>
+ newOut {appendMode = appendMode,
+ closeAtExit = true,
+ fd = fd,
+ name = name}
+
+fun 'a protect' (function: string, name: string, f: unit -> 'a): 'a =
+ f () handle e => raise IO.Io {cause = e,
+ function = function,
+ name = name}
+
+local
+ val readWrite =
+ let
+ open PFS.S
in
- fun openOut file =
- let
- val fd = PFS.createf (file, PIO.O_WRONLY,
- PFS.O.flags (PFS.O.trunc::fileTypeFlags),
- readWrite)
- in
- newOut {fd = fd,
- name = file,
- appendMode = false}
- end
- handle exn => liftExn file "openOut" exn
- fun openAppend file =
+ flags [irusr, iwusr, irgrp, iwgrp, iroth, iwoth]
+ end
+in
+ fun openOut file =
+ protect'
+ ("openOut", file, fn () =>
+ let
+ val fd = PFS.createf (file, Posix.IO.O_WRONLY,
+ PFS.O.flags (PFS.O.trunc::fileTypeFlags),
+ readWrite)
+ in
+ newOut {fd = fd,
+ name = file,
+ appendMode = false}
+ end)
+
+ fun openAppend file =
+ protect'
+ ("openAppend", file, fn () =>
+ let
+ val fd = PFS.createf (file, Posix.IO.O_WRONLY,
+ PFS.O.flags (PFS.O.append::fileTypeFlags),
+ readWrite)
+ in
+ newOut {fd = fd,
+ name = file,
+ appendMode = true}
+ end)
+end
+
+val newOut = fn (fd, name) => newOut {fd = fd,
+ name = name,
+ appendMode = false}
+val outFd = SIO.outFd o getOutstream
+
+(* ------------------------------------------------- *)
+(* instream *)
+(* ------------------------------------------------- *)
+
+datatype state =
+ Closed
+ | Open of {eos: bool}
+ | Stream of SIO.instream
+(* Inv: if !first < !last then !state = Open {eos = false}
+ * if !state = Closed then !first = !last
+ * if !state = Open {eos = true} then !first = !last
+ *)
+
+datatype instream = In of {augmentedReader: PIO.reader,
+ buf: A.array,
+ first: int ref, (* index of first character *)
+ last: int ref, (* one past the index of the last char *)
+ reader: PIO.reader,
+ state: state ref}
+
+local
+ val augmentedReader = PIO.nullRd ()
+ val buf = A.rawArray 0
+ val first = ref 0
+ val last = ref 0
+ val reader = PIO.nullRd ()
+in
+ fun mkInstream s = In {augmentedReader = augmentedReader,
+ buf = buf,
+ first = first,
+ last = last,
+ reader = reader,
+ state = ref (Stream s)}
+end
+
+fun setInstream (In {first, last, state, ...}, s) =
+ (first := 0
+ ; last := 0
+ ; state := Stream s)
+
+fun equalsIn (In {first = f, ...}, In {first = f', ...}) = f = f'
+
+fun inbufferReader (In {reader, ...}) = reader
+
+fun augmentedReaderSel (In {augmentedReader = PIO.RD v, ...}, sel) = sel v
+
+fun readerSel (In {reader = PIO.RD v, ...}, sel) = sel v
+
+fun inbufferName ib = readerSel (ib, #name)
+
+fun inFd ib =
+ case readerSel (ib, #ioDesc) of
+ NONE => raise IO.Io {cause = Fail "<no ioDesc>",
+ function = "inFd",
+ name = inbufferName ib}
+ | SOME ioDesc => valOf (Posix.FileSys.iodToFD ioDesc)
+
+val empty = V.tabulate (0, fn _ => someElem)
+
+fun lastElem v = V.sub (v, V.length v - 1)
+
+local
+ fun make (sel, e: exn) ib =
+ case augmentedReaderSel (ib, sel) of
+ NONE => raise e
+ | SOME x => x
+in
+ val readArr = make (#readArr, IO.BlockingNotSupported)
+ val readArrNB = make (#readArrNB, IO.NonblockingNotSupported)
+ val readVec = make (#readVec, IO.BlockingNotSupported)
+end
+
+fun 'a protect (ib, function: string, f: unit -> 'a): 'a =
+ f () handle e => raise IO.Io {cause = e,
+ function = function,
+ name = inbufferName ib}
+
+fun update (ib as In {buf, first, last, state, ...}) =
+ let
+ val i = readArr ib (AS.full buf)
+ in
+ if i = 0
+ then (state := Open {eos = true}
+ ; false)
+ else (first := 0
+ ; last := i
+ ; true)
+ end
+
+fun input (ib as In {buf, first, last, ...}) =
+ let
+ val f = !first
+ val l = !last
+ in
+ if f < l
+ then (first := l
+ ; AS.vector (AS.slice (buf, f, SOME (l - f))))
+ else
+ let
+ val In {state, ...} = ib
+ in
+ case !state of
+ Closed => empty
+ | Open {eos} =>
+ if eos
+ then (state := Open {eos = false}
+ ; empty)
+ else protect (ib, "input", fn () =>
+ readVec ib (augmentedReaderSel (ib, #chunkSize)))
+ | Stream s =>
+ let
+ val (v, s') = SIO.input s
+ val _ = state := Stream s'
+ in
+ v
+ end
+ end
+ end
+
+(* input1 will move past a temporary end of stream *)
+fun input1 (ib as In {buf, first, last, ...}) =
+ let
+ val f = !first
+ in
+ if f < !last
+ then (first := f + 1
+ ; SOME (A.sub (buf, f)))
+ else
+ let
+ val In {state, ...} = ib
+ in
+ case !state of
+ Closed => NONE
+ | Open {eos} =>
+ if eos
+ then
+ (state := Open {eos = false}
+ ; NONE)
+ else
+ if protect (ib, "input1", fn () => update ib)
+ then
+ (first := 1
+ ; SOME (A.sub (buf, 0)))
+ else NONE
+ | Stream s =>
+ let
+ val (c, s') = SIO.input1' s
+ val _ = state := Stream s'
+ in
+ c
+ end
+ end
+ end
+
+fun inputN (ib as In {buf, first, last, ...}, n) =
+ if n < 0 orelse n > V.maxLen
+ then raise Size
+ else
+ let
+ val f = !first
+ val l = !last
+ val size = l - f
+ in
+ if size >= n
+ then (first := f + n
+ ; AS.vector (AS.slice (buf, f, SOME n)))
+ else
+ let
+ val In {state, ...} = ib
+ in
+ case !state of
+ Closed => empty
+ | Open {eos} =>
+ if eos
+ then (state := Open {eos = false}
+ ; empty)
+ else
+ protect
+ (ib, "inputN", fn () =>
+ let
+ val readArr = readArr ib
+ val inp = A.rawArray n
+ fun fill k =
+ if k >= size
+ then ()
+ else (A.update (inp, k, A.sub (buf, f + k))
+ ; fill (k + 1))
+ val _ = fill 0
+ val _ = first := l
+ fun loop i =
+ if i = n
+ then i
+ else let
+ val j =
+ readArr
+ (AS.slice (inp, i, SOME (n - i)))
+ in
+ if j = 0
+ then (state := Open {eos = true}; i)
+ else loop (i + j)
+ end
+ val i = loop size
+ in
+ if i = n
+ then V.fromArray inp
+ else AS.vector (AS.slice (inp, 0, SOME i))
+ end)
+ | Stream s =>
+ let
+ val (v, s') = SIO.inputN (s, n)
+ val _ = state := Stream s'
+ in
+ v
+ end
+ end
+ end
+
+fun inputAll (ib as In {state, ...}) =
+ case !state of
+ Closed => empty
+ | Open {eos} =>
+ if eos
+ then (state := Open {eos = false}
+ ; empty)
+ else
+ protect
+ (ib, "inputAll", fn () =>
+ let
+ val In {buf, first, last, ...} = ib
+ val readVec = readVec ib
+ val f = !first
+ val l = !last
+ val inp = AS.vector (AS.slice (buf, f, SOME (l - f)))
+ val inps = [inp]
+ fun loop inps =
+ let
+ val inp =
+ readVec (augmentedReaderSel (ib, #chunkSize))
+ in
+ if V.length inp = 0
+ then V.concat (List.rev inps)
+ else loop (inp :: inps)
+ end
+ in
+ loop inps
+ end)
+ | Stream s =>
let
- val fd = PFS.createf (file, PIO.O_WRONLY,
- PFS.O.flags (PFS.O.append::fileTypeFlags),
- readWrite)
+ val (v, s') = SIO.inputAll s
+ val _ = state := Stream s'
in
- newOut {fd = fd,
- name = file,
- appendMode = true}
+ v
end
- handle exn => liftExn file "openAppend" exn
+
+val inputLine =
+ case line of
+ NONE => (fn ib => SOME (input ib))
+ | SOME {isLine, lineElem, ...} =>
+ let
+ val lineVec = V.tabulate (1, fn _ => lineElem)
+ in
+ fn (ib as In {state, ...}) =>
+ case !state of
+ Closed => NONE
+ | Open {eos} =>
+ if eos
+ then NONE
+ else
+ protect
+ (ib, "inputLine", fn () =>
+ let
+ val In {buf, first, last, ...} = ib
+ fun finish (inps, trail) =
+ let
+ val inps = if trail
+ then lineVec :: inps
+ else inps
+ val inp = V.concat (List.rev inps)
+ in
+ SOME inp
+ end
+ fun loop inps =
+ if !first < !last orelse update ib
+ then
+ let
+ val f = !first
+ val l = !last
+ (* !first < !last *)
+ fun loop' i = (* pre: !first <= i <= !last *)
+ let
+ fun done j = (* pre: !first < j <= !last *)
+ let
+ val inp = AS.vector (AS.slice (buf, f, SOME (j - f)))
+ in
+ first := j;
+ inp::inps
+ end
+ in
+ if i >= l
+ then loop (done i)
+ else if isLine (A.sub (buf, i))
+ then finish (done (i + 1), false)
+ else loop' (i + 1)
+ end
+ in
+ loop' f
+ end
+ else (case inps of
+ [] => NONE
+ | _ => finish (inps, true))
+ in
+ loop []
+ end)
+ | Stream s =>
+ Option.map
+ (fn (v, s') => (state := Stream s'; v))
+ (SIO.inputLine s)
+ end
+
+fun canInput (ib as In {state, ...}, n) =
+ if n < 0 orelse n > V.maxLen
+ then raise Size
+ else
+ case !state of
+ Closed => SOME 0
+ | Open {eos} =>
+ if eos
+ then SOME 0
+ else
+ protect
+ (ib, "canInput", fn () =>
+ let
+ val readArrNB = readArrNB ib
+ val In {buf, first, last, ...} = ib
+ val f = !first
+ val l = !last
+ val read = l - f
+ val _ =
+ if f > 0
+ then
+ (AS.copy {di = 0,
+ dst = buf,
+ src = AS.slice (buf, f, SOME read)}
+ ; first := 0)
+ else ()
+ val size = A.length buf
+ (* 0 = !first *)
+ fun loop read =
+ if read = size
+ then read
+ else
+ let
+ val slice = AS.slice (buf, read, NONE)
+ val i = readArrNB slice
+ in
+ case i of
+ NONE => read
+ | SOME i =>
+ if 0 = i then read else loop (read + i)
+ end
+ val read = loop read
+ val _ = last := read
+ in
+ SOME (if read > 0
+ then Int.min (n, read)
+ else (state := Open {eos = true}; 0))
+ end)
+ | Stream s => SIO.canInput (s, n)
+
+fun lookahead (ib as In {buf, first, last, ...}) =
+ let
+ val f = !first
+ val l = !last
+ in
+ if f < l
+ then SOME (A.sub (buf, f))
+ else
+ let
+ val In {state, ...} = ib
+ in
+ case !state of
+ Closed => NONE
+ | Open {eos, ...} =>
+ if eos
+ then NONE
+ else if protect (ib, "lookahead", fn () => update ib)
+ then SOME (A.sub (buf, 0))
+ else NONE
+ | Stream s => Option.map #1 (SIO.input1 s)
+ end
+ end
+
+fun closeIn (ib as In {first, last, state, ...}) =
+ case !state of
+ Closed => ()
+ | Open _ =>
+ (first := !last
+ ; state := Closed
+ ; protect (ib, "closeIn", fn () => readerSel (ib, #close) ()))
+ | Stream s => SIO.closeIn s
+
+fun endOfStream (ib as In {first, last, state, ...}) =
+ !first = !last
+ andalso
+ (case !state of
+ Closed => true
+ | Open {eos, ...} =>
+ eos orelse not (protect (ib, "endOfStream", fn () => update ib))
+ | Stream s => SIO.endOfStream s)
+
+fun mkInbuffer' {reader, closed, bufferContents} =
+ let
+ val (state, first, last, buf) =
+ if closed
+ then (ref Closed, ref 0, ref 0, Array.array (0, someElem))
+ else let
+ val PIO.RD {chunkSize, ...} = reader
+ val buf = Array.array (chunkSize, someElem)
+ val first = ref 0
+ val (state, last) =
+ case bufferContents of
+ NONE => (ref (Open {eos = false}), ref 0)
+ | SOME v => if V.length v = 0
+ then (ref (Open {eos = true}), ref 0)
+ else (V.appi (fn (i, c) => A.update (buf, i, c)) v;
+ (ref (Open {eos = false}), ref (V.length v)))
+ in
+ (state, first, last, buf)
+ end
+ in
+ In {augmentedReader = PIO.augmentReader reader,
+ buf = buf,
+ first = first,
+ last = last,
+ reader = reader,
+ state = state}
+ end
+
+fun mkInbuffer (reader, bufferContents) =
+ mkInbuffer' {bufferContents = if V.length bufferContents = 0
+ then NONE
+ else SOME bufferContents,
+ closed = false,
+ reader = reader}
+
+fun openVector v =
+ mkInbuffer' {bufferContents = NONE,
+ closed = false,
+ reader = PIO.openVector v}
+
+val openInbuffers : (instream * {close: bool}) list ref = ref []
+
+fun getInstream (ib as In {state, ...}) =
+ let
+ fun doit (closed: bool, bufferContents) =
+ let
+ val In {reader, ...} = ib
+ val (ibs, openInbuffers') =
+ List.partition (fn (ib', _) => equalsIn (ib, ib'))
+ (!openInbuffers)
+ val _ = openInbuffers := openInbuffers'
+ val closeAtExit =
+ List.foldr (fn ((_, {close = close'}), close) =>
+ close orelse close')
+ false ibs
+ in
+ SIO.mkInstream'' {bufferContents = bufferContents,
+ closeAtExit = closeAtExit,
+ closed = closed,
+ reader = reader}
+ end
+ in
+ case !state of
+ Closed => doit (true, NONE)
+ | Open {eos} =>
+ if eos
+ then doit (false, SOME empty)
+ else
+ let
+ val In {buf, first, last, ...} = ib
+ val f = !first
+ val l = !last
+ in
+ if f < l
+ then
+ doit (false,
+ SOME (AS.vector
+ (AS.slice (buf, f, SOME (l - f)))))
+ else doit (false, NONE)
+ end
+ | Stream s => s
+ end
+
+val mkInbuffer'' =
+ let
+ val _ =
+ Cleaner.addNew
+ (Cleaner.atExit, fn () =>
+ List.app (fn (ib, {close}) => if close then closeIn ib else ())
+ (!openInbuffers))
+ in
+ fn {bufferContents, closeAtExit, closed, reader} =>
+ let
+ val ib = mkInbuffer' {bufferContents = bufferContents,
+ closed = closed,
+ reader = reader}
+ val _ = if closed
+ then ()
+ else openInbuffers := ((ib, {close = closeAtExit})
+ :: (!openInbuffers))
+ in
+ ib
end
- val newOut = fn (fd, name) => newOut {fd = fd,
- name = name,
- appendMode = false}
- val outFd = SIO.outFd o getOutstream
-
- (*---------------*)
- (* instream *)
- (*---------------*)
-
- fun newIn {fd, name, buffer_contents, atExit} =
- let
- val reader = mkReader {fd = fd, name = name, initBlkMode = true}
- val instream = SIO.mkInstream'' {reader = reader,
- closed = false,
- buffer_contents = buffer_contents,
- atExit = atExit}
- in
- mkInstream instream
- end
- val newIn = fn {fd, name, atExit} =>
- newIn {fd = fd, name = name, buffer_contents = NONE, atExit = atExit}
- val newIn = fn {fd, name} =>
- newIn {fd = fd, name = name, atExit = {close = true}}
- val stdIn = newIn {fd = PFS.stdin,
- name = "<stdin>"}
- fun openIn file =
- let
- val fd = PFS.openf (file, PIO.O_RDONLY,
- PFS.O.flags fileTypeFlags)
- in
- newIn {fd = fd,
- name = file}
- end
- handle exn => liftExn file "openIn" exn
- val newIn = fn (fd, name) => newIn {fd = fd, name = name}
- val inFd = SIO.inFd o getInstream
end
+
+fun mkInbuffer (reader, bufferContents) =
+ mkInbuffer'' {bufferContents = if V.length bufferContents = 0
+ then NONE
+ else SOME bufferContents,
+ closeAtExit = true,
+ closed = false,
+ reader = reader}
+
+fun scanStream f is =
+ case f SIO.input1 (getInstream is) of
+ NONE => NONE
+ | SOME (v, s') => (setInstream (is, s'); SOME v)
+
+val closeIn = fn ib =>
+ let
+ val _ = openInbuffers := List.filter (fn (ib',_) =>
+ not (equalsIn (ib, ib')))
+ (!openInbuffers)
+ in
+ closeIn ib
+ end
+
+fun newIn {bufferContents, closeAtExit, fd, name} =
+ let
+ val reader = mkReader {fd = fd, initBlkMode = true, name = name}
+ in
+ mkInbuffer'' {bufferContents = bufferContents,
+ closeAtExit = closeAtExit,
+ closed = false,
+ reader = reader}
+ end
+
+val newIn = fn (fd, name) =>
+ newIn {bufferContents = NONE,
+ closeAtExit = true,
+ fd = fd,
+ name = name}
+
+val stdIn = newIn (PFS.stdin, "<stdin>")
+
+fun openIn file =
+ protect'
+ ("openIn", file, fn () =>
+ let
+ val fd = PFS.openf (file, Posix.IO.O_RDONLY, PFS.O.flags fileTypeFlags)
+ in
+ newIn (fd, file)
+ end)
+
+end
1.7 +38 -20 mlton/basis-library/io/imperative-io.sig
Index: imperative-io.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/imperative-io.sig,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- imperative-io.sig 21 Nov 2003 21:47:53 -0000 1.6
+++ imperative-io.sig 12 Jan 2004 18:00:21 -0000 1.7
@@ -31,33 +31,51 @@
signature IMPERATIVE_IO_EXTRA =
sig
- include IMPERATIVE_IO
+ structure StreamIO: STREAM_IO_EXTRA
+
+ type elem = StreamIO.elem
+ type instream
+ type outstream
+ type vector = StreamIO.vector
type vector_slice
- val openVector: vector -> instream
- val inputLine: instream -> vector option
+ val canInput: instream * int -> int option
+ val closeIn: instream -> unit
+ val closeOut: outstream -> unit
+ val endOfStream: instream -> bool
val equalsIn: instream * instream -> bool
- val scanStream: ((elem, StreamIO.instream) StringCvt.reader ->
- ('a, StreamIO.instream) StringCvt.reader) ->
- instream -> 'a option
-
- val outputSlice: outstream * vector_slice -> unit
val equalsOut: outstream * outstream -> bool
- end
-
-signature IMPERATIVE_IO_EXTRA_FILE =
- sig
- include IMPERATIVE_IO_EXTRA
-
- val openIn: string -> instream
- val newIn: Posix.IO.file_desc * string -> instream
+ val flushOut: outstream -> unit
+ val getInstream: instream -> StreamIO.instream
+ val getOutstream: outstream -> StreamIO.outstream
+ val getPosOut: outstream -> StreamIO.out_pos
val inFd: instream -> Posix.IO.file_desc
- val stdIn: instream
-
- val openOut: string -> outstream
- val openAppend: string -> outstream
+ val input1: instream -> elem option
+ val input: instream -> vector
+ val inputAll: instream -> vector
+ val inputLine: instream -> vector option
+ val inputN: instream * int -> vector
+ val lookahead: instream -> elem option
+ val mkInstream: StreamIO.instream -> instream
+ val mkOutstream: StreamIO.outstream -> outstream
+ val newIn: Posix.IO.file_desc * string -> instream
val newOut: Posix.IO.file_desc * string -> outstream
+ val openAppend: string -> outstream
+ val openIn: string -> instream
+ val openOut: string -> outstream
+ val openVector: vector -> instream
val outFd: outstream -> Posix.IO.file_desc
+ val output1: outstream * elem -> unit
+ val output: outstream * vector -> unit
+ val outputSlice: outstream * vector_slice -> unit
+ val scanStream:
+ ((elem, StreamIO.instream) StringCvt.reader
+ -> ('a, StreamIO.instream) StringCvt.reader)
+ -> instream -> 'a option
+ val setInstream: instream * StreamIO.instream -> unit
+ val setOutstream: outstream * StreamIO.outstream -> unit
+ val setPosOut: outstream * StreamIO.out_pos -> unit
val stdErr: outstream
+ val stdIn: instream
val stdOut: outstream
end
1.22 +96 -78 mlton/basis-library/io/stream-io.fun
Index: stream-io.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/stream-io.fun,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- stream-io.fun 2 Jan 2004 03:32:34 -0000 1.21
+++ stream-io.fun 12 Jan 2004 18:00:21 -0000 1.22
@@ -65,7 +65,7 @@
datatype buf = Buf of {array: A.array,
size: int ref}
- datatype buffer_mode = NO_BUF
+ datatype bufferMode = NO_BUF
| LINE_BUF of buf
| BLOCK_BUF of buf
fun newLineBuf bufSize =
@@ -83,7 +83,7 @@
datatype outstream = Out of {writer: writer,
augmented_writer: writer,
state: state ref,
- buffer_mode: buffer_mode ref}
+ bufferMode: bufferMode ref}
fun equalsOut (os1 as Out {state = state1, ...},
os2 as Out {state = state2, ...}) = state1 = state2
@@ -144,7 +144,7 @@
fun output (os as Out {augmented_writer,
state,
- buffer_mode, ...}, v) =
+ bufferMode, ...}, v) =
if terminated (!state)
then liftExn (outstreamName os) "output" IO.ClosedStream
else let
@@ -160,7 +160,7 @@
size := newSize)
end
in
- case !buffer_mode of
+ case !bufferMode of
NO_BUF => put ()
| LINE_BUF buf => doit (buf, fn () => (case line of
NONE => false
@@ -188,8 +188,8 @@
* before modifying it, and test after you do, to make sure that it
* hasn't been slowed down.
*)
- fun output1 (os as Out {buffer_mode, ...}, c): unit =
- case !buffer_mode of
+ fun output1 (os as Out {bufferMode, ...}, c): unit =
+ case !bufferMode of
BLOCK_BUF (Buf {array, size}) =>
let
val n = !size
@@ -245,7 +245,7 @@
fun outputSlice (os as Out {augmented_writer,
state,
- buffer_mode, ...}, v) =
+ bufferMode, ...}, v) =
if terminated (!state)
then liftExn (outstreamName os) "output" IO.ClosedStream
else let
@@ -261,7 +261,7 @@
size := newSize)
end
in
- case !buffer_mode of
+ case !bufferMode of
NO_BUF => put ()
| LINE_BUF buf => doit (buf, fn () => (case line of
NONE => false
@@ -272,20 +272,20 @@
fun flushOut (os as Out {augmented_writer,
state,
- buffer_mode, ...}) =
+ bufferMode, ...}) =
if terminated (!state)
then ()
- else case !buffer_mode of
+ else case !bufferMode of
NO_BUF => ()
| LINE_BUF buf => flushBuf (augmented_writer, buf)
| BLOCK_BUF buf => flushBuf (augmented_writer, buf)
handle exn => liftExn (outstreamName os) "flushOut" exn
- fun makeTerminated (Out {buffer_mode, ...}) =
+ fun makeTerminated (Out {bufferMode, ...}) =
let
fun doit (Buf {array, size}) = size := A.length array
in
- case !buffer_mode of
+ case !bufferMode of
BLOCK_BUF b => doit b
| LINE_BUF b => doit b
| NO_BUF => ()
@@ -302,60 +302,60 @@
; makeTerminated os)
handle exn => liftExn (outstreamName os) "closeOut" exn
- fun getBufferMode (os as Out {buffer_mode, ...}) =
- case !buffer_mode of
+ fun getBufferMode (os as Out {bufferMode, ...}) =
+ case !bufferMode of
NO_BUF => IO.NO_BUF
| LINE_BUF _ => IO.LINE_BUF
| BLOCK_BUF _ => IO.BLOCK_BUF
- fun setBufferMode (os as Out {buffer_mode, ...}, mode) =
+ fun setBufferMode (os as Out {bufferMode, ...}, mode) =
case mode of
IO.NO_BUF => (flushOut os;
- buffer_mode := NO_BUF)
+ bufferMode := NO_BUF)
| IO.LINE_BUF => let
fun doit () =
- buffer_mode :=
+ bufferMode :=
newLineBuf (writerSel (outstreamWriter os, #chunkSize))
in
- case !buffer_mode of
+ case !bufferMode of
NO_BUF => doit ()
| LINE_BUF _ => ()
| BLOCK_BUF _ => doit ()
end
| IO.BLOCK_BUF => let
fun doit () =
- buffer_mode :=
+ bufferMode :=
newBlockBuf (writerSel (outstreamWriter os, #chunkSize))
in
- case !buffer_mode of
+ case !bufferMode of
NO_BUF => doit ()
| LINE_BUF _ => doit ()
| BLOCK_BUF _ => ()
end
- fun mkOutstream' {writer, closed, buffer_mode} =
+ fun mkOutstream' {writer, closed, bufferMode} =
let
val bufSize = writerSel (writer, #chunkSize)
in
Out {writer = writer,
augmented_writer = PIO.augmentWriter writer,
state = ref (if closed then Closed else Active),
- buffer_mode = ref (case buffer_mode of
+ bufferMode = ref (case bufferMode of
IO.NO_BUF => NO_BUF
| IO.LINE_BUF => newLineBuf bufSize
| IO.BLOCK_BUF => newBlockBuf bufSize)}
end
- fun mkOutstream (writer, buffer_mode) =
- mkOutstream' {writer = writer, closed = false, buffer_mode = buffer_mode}
+ fun mkOutstream (writer, bufferMode) =
+ mkOutstream' {writer = writer, closed = false, bufferMode = bufferMode}
- fun getWriter (os as Out {writer, state, buffer_mode, ...}) =
+ fun getWriter (os as Out {writer, state, bufferMode, ...}) =
if closed (!state)
then liftExn (outstreamName os) "getWriter" IO.ClosedStream
else (flushOut os
; state := Terminated
; makeTerminated os
; (writer,
- case !buffer_mode of
+ case !bufferMode of
NO_BUF => IO.NO_BUF
| LINE_BUF _ => IO.LINE_BUF
| BLOCK_BUF _ => IO.BLOCK_BUF))
@@ -730,7 +730,7 @@
in V.length inp = 0
end
- fun mkInstream' {reader, closed, buffer_contents} =
+ fun mkInstream' {bufferContents, closed, reader} =
let
val next = ref (if closed then Closed else End)
val base =
@@ -738,7 +738,7 @@
NONE => NONE
| SOME getPos => SOME (getPos ())
val buf =
- case buffer_contents of
+ case bufferContents of
NONE => Buf {inp = empty,
base = base,
next = next}
@@ -758,15 +758,18 @@
pos = 0,
buf = buf}
end
- fun mkInstream (reader, buffer_contents) =
- mkInstream' {reader = reader, closed = false,
- buffer_contents = if V.length buffer_contents = 0
+
+ fun mkInstream (reader, bufferContents) =
+ mkInstream' {bufferContents = if 0 = V.length bufferContents
then NONE
- else SOME buffer_contents}
+ else SOME bufferContents,
+ closed = false,
+ reader = reader}
+
fun openVector v =
- mkInstream' {reader = PIO.openVector v,
+ mkInstream' {bufferContents = NONE,
closed = false,
- buffer_contents = NONE}
+ reader = PIO.openVector v}
fun getReader (is as In {common = {reader, tail, ...}, ...}) =
case !(!tail) of
@@ -805,8 +808,8 @@
structure VectorSlice: MONO_VECTOR_SLICE
structure Array: MONO_ARRAY
structure ArraySlice: MONO_ARRAY_SLICE
- sharing type PrimIO.elem = Vector.elem = VectorSlice.elem
- = Array.elem = ArraySlice.elem
+ sharing type PrimIO.elem = Vector.elem = VectorSlice.elem = Array.elem
+ = ArraySlice.elem
sharing type PrimIO.vector = Vector.vector = VectorSlice.vector
= Array.vector = ArraySlice.vector
sharing type PrimIO.vector_slice = VectorSlice.slice
@@ -824,9 +827,9 @@
where type reader = S.PrimIO.reader
where type writer = S.PrimIO.writer
where type pos = S.PrimIO.pos =
- StreamIOExtra(open S
- val line = NONE
- val xlatePos = NONE)
+ StreamIOExtra (open S
+ val line = NONE
+ val xlatePos = NONE)
signature STREAM_IO_EXTRA_FILE_ARG =
sig
@@ -871,34 +874,42 @@
| NONE => liftExn (outstreamName os) "outFd" (Fail "<no ioDesc>")
val openOutstreams : (outstream * {close: bool}) list ref = ref []
+
val mkOutstream'' =
- let
- val _ = Cleaner.addNew
- (Cleaner.atExit, fn () =>
- List.app (fn (os, {close}) =>
- if close
- then closeOut os
- else flushOut os) (!openOutstreams))
- in
- fn {writer, closed, buffer_mode, atExit} =>
- let
- val os = mkOutstream' {writer = writer,
- closed = closed,
- buffer_mode = buffer_mode}
- val _ = if closed
- then ()
- else openOutstreams := (os,atExit) :: (!openOutstreams)
- in
- os
- end
- end
- fun mkOutstream' {writer, closed, buffer_mode} =
- mkOutstream'' {writer = writer, closed = closed,
- buffer_mode = buffer_mode,
- atExit = {close = true}}
- fun mkOutstream (writer, buffer_mode) =
- mkOutstream' {writer = writer, closed = false,
- buffer_mode = buffer_mode}
+ let
+ val _ = Cleaner.addNew
+ (Cleaner.atExit, fn () =>
+ List.app (fn (os, {close}) =>
+ if close
+ then closeOut os
+ else flushOut os) (!openOutstreams))
+ in
+ fn {bufferMode, closeAtExit, closed, writer} =>
+ let
+ val os = mkOutstream' {bufferMode = bufferMode,
+ closed = closed,
+ writer = writer}
+ val _ =
+ if closed
+ then ()
+ else openOutstreams := ((os, {close = closeAtExit})
+ :: (!openOutstreams))
+ in
+ os
+ end
+ end
+
+ fun mkOutstream' {bufferMode, closed, writer} =
+ mkOutstream'' {bufferMode = bufferMode,
+ closeAtExit = true,
+ closed = closed,
+ writer = writer}
+
+ fun mkOutstream (writer, bufferMode) =
+ mkOutstream' {bufferMode = bufferMode,
+ closed = false,
+ writer = writer}
+
val closeOut = fn os =>
let
val _ = openOutstreams := List.filter (fn (os', _) =>
@@ -913,6 +924,7 @@
(*---------------*)
fun readerSel (PIO.RD v, sel) = sel v
+
fun instreamName is = readerSel (instreamReader is, #name)
fun inFd is =
@@ -921,17 +933,18 @@
| NONE => liftExn (instreamName is) "inFd" (Fail "<no ioDesc>")
val closeAtExits: Close.t list ref = ref []
+
val mkInstream'' =
let
val _ = Cleaner.addNew (Cleaner.atExit, fn () =>
List.app Close.close (!closeAtExits))
in
- fn {reader, closed, buffer_contents, atExit = {close = closeAtExit}} =>
+ fn {bufferContents, closeAtExit, closed, reader} =>
let
val is =
- mkInstream' {reader = reader,
+ mkInstream' {bufferContents = bufferContents,
closed = closed,
- buffer_contents = buffer_contents}
+ reader = reader}
val _ =
if closed orelse not closeAtExit
then ()
@@ -940,15 +953,20 @@
is
end
end
- fun mkInstream' {reader, closed, buffer_contents} =
- mkInstream'' {reader = reader, closed = closed,
- buffer_contents = buffer_contents,
- atExit = {close = true}}
- fun mkInstream (reader, buffer_contents) =
- mkInstream' {reader = reader, closed = false,
- buffer_contents = if V.length buffer_contents = 0
- then NONE
- else SOME buffer_contents}
+
+ fun mkInstream' {bufferContents, closed, reader} =
+ mkInstream'' {bufferContents = bufferContents,
+ closeAtExit = true,
+ closed = closed,
+ reader = reader}
+
+
+ fun mkInstream (reader, bufferContents) =
+ mkInstream' {bufferContents = (if V.length bufferContents = 0 then NONE
+ else SOME bufferContents),
+ closed = false,
+ reader = reader}
+
val closeIn = fn is =>
let
val _ =
1.10 +17 -20 mlton/basis-library/io/stream-io.sig
Index: stream-io.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/stream-io.sig,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- stream-io.sig 21 Nov 2003 21:47:53 -0000 1.9
+++ stream-io.sig 12 Jan 2004 18:00:21 -0000 1.10
@@ -1,15 +1,13 @@
signature STREAM_IO =
sig
type elem
- type vector
-
type instream
- type outstream
type out_pos
-
+ type outstream
+ type pos
type reader
+ type vector
type writer
- type pos
val canInput: instream * int -> int option
val closeIn: instream -> unit
@@ -48,21 +46,20 @@
val make: instream -> t
end
- val openVector: vector -> instream
+ val equalsIn: instream * instream -> bool
+ val equalsOut: outstream * outstream -> bool
val input1': instream -> elem option * instream
val inputLine: instream -> (vector * instream) option
- val equalsIn: instream * instream -> bool
val instreamReader: instream -> reader
- val mkInstream': {reader: reader,
+ val mkInstream': {bufferContents: vector option,
closed: bool,
- buffer_contents: vector option} -> instream
-
+ reader: reader} -> instream
+ val mkOutstream': {bufferMode: IO.buffer_mode,
+ closed: bool,
+ writer: writer} -> outstream
+ val openVector: vector -> instream
val outputSlice: outstream * vector_slice -> unit
- val equalsOut: outstream * outstream -> bool
val outstreamWriter: outstream -> writer
- val mkOutstream': {writer: writer,
- closed: bool,
- buffer_mode: IO.buffer_mode} -> outstream
end
signature STREAM_IO_EXTRA_FILE =
@@ -70,13 +67,13 @@
include STREAM_IO_EXTRA
val inFd: instream -> Posix.IO.file_desc
- val mkInstream'': {reader: reader,
+ val mkInstream'': {bufferContents: vector option,
+ closeAtExit: bool,
closed: bool,
- buffer_contents: vector option,
- atExit: {close: bool}} -> instream
+ reader: reader} -> instream
val outFd: outstream -> Posix.IO.file_desc
- val mkOutstream'': {writer: writer,
+ val mkOutstream'': {bufferMode: IO.buffer_mode,
+ closeAtExit: bool,
closed: bool,
- buffer_mode: IO.buffer_mode,
- atExit: {close: bool}} -> outstream
+ writer: writer} -> outstream
end
1.20 +23 -37 mlton/basis-library/io/text-io.sml
Index: text-io.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/text-io.sml,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- text-io.sml 27 Dec 2003 02:58:04 -0000 1.19
+++ text-io.sml 12 Jan 2004 18:00:21 -0000 1.20
@@ -1,51 +1,37 @@
structure TextIO: TEXT_IO_EXTRA =
struct
- structure S = struct
- structure PrimIO = TextPrimIO
- structure Array = CharArray
- structure ArraySlice = CharArraySlice
- structure Vector = CharVector
- structure VectorSlice = CharVectorSlice
- val someElem = (#"\000": Char.char)
- val lineElem = (#"\n": Char.char)
- fun isLine c = c = lineElem
- val line = SOME {isLine = isLine,
- lineElem = lineElem}
- val xlatePos = SOME {fromInt = fn i => i,
- toInt = fn i => i}
- structure Cleaner = Cleaner
- end
- structure StreamIO = StreamIOExtraFile (open S)
- structure SIO = StreamIO
- structure S = struct
- open S
- structure StreamIO = StreamIO
- end
- structure BufferI = BufferIExtraFile (open S)
- structure BI = BufferI
- structure S = struct
- open S
- structure BufferI = BufferI
- val chunkSize = Primitive.TextIO.bufSize
- val fileTypeFlags = [PosixPrimitive.FileSys.O.text]
- val mkReader = Posix.IO.mkTextReader
- val mkWriter = Posix.IO.mkTextWriter
- end
- structure FastImperativeIO = FastImperativeIOExtraFile (open S)
- open FastImperativeIO
+ structure IO =
+ ImperativeIO (structure Array = CharArray
+ structure ArraySlice = CharArraySlice
+ structure Cleaner = Cleaner
+ structure PrimIO = TextPrimIO
+ structure Vector = CharVector
+ structure VectorSlice = CharVectorSlice
+
+ val chunkSize = Primitive.TextIO.bufSize
+ val fileTypeFlags = [PosixPrimitive.FileSys.O.text]
+ val line = SOME {isLine = fn c => c = #"\n",
+ lineElem = #"\n"}
+ val mkReader = Posix.IO.mkTextReader
+ val mkWriter = Posix.IO.mkTextWriter
+ val someElem = (#"\000": Char.char)
+ val xlatePos = SOME {fromInt = fn i => i,
+ toInt = fn i => i})
+ open IO
structure StreamIO =
struct
- open SIO
+ open StreamIO
+
fun outputSubstr (s, ss) = outputSlice (s, ss)
end
- fun outputSubstr (s, ss) = outputSlice (s, ss)
+ val outputSubstr = outputSlice
+
val openString = openVector
+
fun print (s: string) = (output (stdOut, s); flushOut stdOut)
end
-
-structure TextIO = TextIO
structure TextIOGlobal: TEXT_IO_GLOBAL = TextIO
open TextIOGlobal
1.28 +1 -6 mlton/basis-library/libs/build
Index: build
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/build,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -r1.27 -r1.28
--- build 1 Dec 2003 18:22:16 -0000 1.27
+++ build 12 Jan 2004 18:00:21 -0000 1.28
@@ -118,17 +118,12 @@
io/stream-io.sig
io/stream-io.fun
-io/buffer-i.sig
-io/buffer-i.fun
io/imperative-io.sig
io/imperative-io.fun
-io/fast-imperative-io.sig
-io/fast-imperative-io.fun
io/bin-stream-io.sig
-io/text-stream-io.sig
-io/bin-or-text-io.fun
io/bin-io.sig
io/bin-io.sml
+io/text-stream-io.sig
io/text-io.sig
io/text-io.sml