Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/branches/rt-transition/system/Basis/Implementation/IO/bin-io.sml
ViewVC logotype

Annotation of /sml/branches/rt-transition/system/Basis/Implementation/IO/bin-io.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2849 - (view) (download)

1 : jhr 2849 (* bin-io.sml
2 : monnier 416 *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 : jhr 2849 * COPYRIGHT (c) 2007 Fellowship of SML/NJ
5 : monnier 416 *
6 :     * QUESTION: what operations should raise exceptions when the stream is
7 :     * closed?
8 :     *
9 :     *)
10 :    
11 :     local
12 :     structure Int = IntImp
13 :     structure Position = PositionImp
14 :     in
15 : jhr 2849 structure BinIO : BIN_IO = struct
16 : monnier 416
17 : jhr 2849 structure PIO = BinPrimIO
18 : monnier 416 structure A = Word8Array
19 : mblume 1350 structure AS = Word8ArraySlice
20 : monnier 416 structure V = Word8Vector
21 : mblume 1350 structure VS = Word8VectorSlice
22 : monnier 416 structure Pos = Position
23 :    
24 :     (* an element for initializing buffers *)
25 :     val someElem = (0w0 : Word8.word)
26 :    
27 :     (** Fast, but unsafe version (from Word8Vector) **
28 :     val vecSub = InlineT.Word8Vector.sub
29 :     val arrUpdate = InlineT.Word8Array.update
30 :     (* fast vector extract operation. This should never be called with
31 :     * a length of 0.
32 :     *)
33 :     fun vecExtract (v, base, optLen) = let
34 :     val len = V.length v
35 :     fun newVec n = let
36 :     val newV = Assembly.A.create_s n
37 :     fun fill i = if (i < n)
38 :     then (
39 :     InlineT.Word8Vector.update(newV, i, vecSub(v, base+i));
40 :     fill(i+1))
41 :     else ()
42 :     in
43 :     fill 0; newV
44 :     end
45 :     in
46 :     case (base, optLen)
47 :     of (0, NONE) => v
48 :     | (_, NONE) => newVec (len - base)
49 :     | (_, SOME n) => newVec n
50 :     (* end case *)
51 :     end
52 :     **)
53 : mblume 1350 val vecExtract = VS.vector o VS.slice
54 : monnier 416 val vecSub = V.sub
55 :     val arrUpdate = A.update
56 :     val empty = V.fromList[]
57 :    
58 :     structure StreamIO =
59 :     struct
60 :     type vector = V.vector
61 :     type elem = V.elem
62 :     type reader = PIO.reader
63 :     type writer = PIO.writer
64 :     type pos = PIO.pos
65 :    
66 :     (*** Functional input streams ***
67 :     ** We represent an instream by a pointer to a buffer and an offset
68 :     ** into the buffer. The buffers are chained by the "more" field from
69 :     ** the beginning of the stream towards the end. If the "more" field
70 :     ** is EOS, then it refers to an empty buffer (consuming the EOF marker
71 :     ** involves moving the stream from immeditaly in front of the EOS to
72 :     ** to the empty buffer). A "more" field of TERMINATED marks a
73 :     ** terminated stream. We also have the invariant that the "tail"
74 :     ** field of the "info" structure points to a more ref that is either
75 :     ** NOMORE or TERMINATED.
76 :     **)
77 :     datatype instream = ISTRM of (in_buffer * int)
78 :     and in_buffer = IBUF of {
79 :     basePos : pos option,
80 :     more : more ref,
81 :     data : vector,
82 :     info : info
83 :     }
84 :     and more
85 :     = MORE of in_buffer (* forward link to additional data *)
86 :     | EOS of in_buffer (* End of stream marker *)
87 :     | NOMORE (* placeholder for forward link *)
88 :     | TERMINATED (* termination of the stream *)
89 :    
90 :     and info = INFO of {
91 :     reader : reader,
92 :     readVec : int -> vector,
93 :     readVecNB : (int -> vector) option,
94 :     closed : bool ref,
95 :     getPos : unit -> pos option,
96 :     tail : more ref ref, (* points to the more cell of the last buffer *)
97 :     cleanTag : CleanIO.tag
98 :     }
99 :    
100 :     fun infoOfIBuf (IBUF{info, ...}) = info
101 :     fun chunkSzOfIBuf buf = let
102 :     val INFO{reader=PIO.RD{chunkSize, ...}, ...} = infoOfIBuf buf
103 :     in
104 :     chunkSize
105 :     end
106 :     fun readVec (IBUF{info=INFO{readVec=f, ...}, ...}) = f
107 :    
108 :     fun inputExn (INFO{reader=PIO.RD{name, ...}, ...}, mlOp, exn) =
109 :     raise IO.Io{function=mlOp, name=name, cause=exn}
110 :    
111 :     (* this exception is raised by readVecNB in the blocking case *)
112 :     exception WouldBlock
113 :    
114 :     fun extendStream (readFn, mlOp, buf as IBUF{more, info, ...}) = (let
115 :     val INFO{getPos, tail, ...} = info
116 :     val basePos = getPos()
117 :     val chunk = readFn (chunkSzOfIBuf buf)
118 :     val newMore = ref NOMORE
119 :     val buf' = IBUF{
120 :     basePos = basePos, data = chunk,
121 :     more = newMore, info = info
122 :     }
123 :     val next = if (V.length chunk = 0) then EOS buf' else MORE buf'
124 :     in
125 :     more := next;
126 :     tail := newMore;
127 :     next
128 :     end
129 :     handle ex => inputExn(info, mlOp, ex))
130 :    
131 :     fun getBuffer (readFn, mlOp) (buf as IBUF{more, info, ...}) = (
132 :     case !more
133 :     of TERMINATED => (EOS buf)
134 :     | NOMORE => extendStream (readFn, mlOp, buf)
135 :     | more => more
136 :     (* end case *))
137 :    
138 :     (* read a chunk that is at least the specified size *)
139 :     fun readChunk buf = let
140 :     val INFO{readVec, reader=PIO.RD{chunkSize, ...}, ...} =
141 :     infoOfIBuf buf
142 :     in
143 :     case (chunkSize - 1)
144 :     of 0 => (fn n => readVec n)
145 :     | k => (* round up to next multiple of chunkSize *)
146 :     (fn n => readVec(Int.quot((n+k), chunkSize) * chunkSize))
147 :     (* end case *)
148 :     end
149 :    
150 :     fun generalizedInput getBuf = let
151 :     fun get (ISTRM(buf as IBUF{data, ...}, pos)) = let
152 :     val len = V.length data
153 :     in
154 :     if (pos < len)
155 :     then (vecExtract(data, pos, NONE), ISTRM(buf, len))
156 :     else (case (getBuf buf)
157 :     of (EOS buf) => (empty, ISTRM(buf, 0))
158 :     | (MORE rest) => get (ISTRM(rest, 0))
159 :     | _ => raise Fail "bogus getBuf"
160 :     (* end case *))
161 :     end
162 :     in
163 :     get
164 :     end
165 :    
166 :     (* terminate an input stream *)
167 :     fun terminate (INFO{tail, cleanTag, ...}) = (case !tail
168 :     of (m as ref NOMORE) => (
169 :     CleanIO.removeCleaner cleanTag;
170 :     m := TERMINATED)
171 :     | (m as ref TERMINATED) => ()
172 : monnier 498 | _ => raise Match (* shut up compiler *)
173 : monnier 416 (* end case *))
174 :    
175 :     fun input (strm as ISTRM(buf, _)) =
176 :     generalizedInput (getBuffer (readVec buf, "input")) strm
177 :     fun input1 (ISTRM(buf, pos)) = let
178 :     val IBUF{data, more, ...} = buf
179 :     in
180 :     if (pos < V.length data)
181 :     then SOME(vecSub(data, pos), ISTRM(buf, pos+1))
182 :     else (case !more
183 :     of (MORE buf) => input1 (ISTRM(buf, 0))
184 :     | (EOS _) => NONE
185 :     | NOMORE => (
186 :     case extendStream (readVec buf, "input1", buf)
187 :     of (MORE rest) => input1 (ISTRM(rest, 0))
188 :     | _ => NONE
189 :     (* end case *))
190 :     | TERMINATED => NONE
191 :     (* end case *))
192 :     end
193 :     fun inputN (ISTRM(buf, pos), n) = let
194 :     fun join (item, (list, strm)) = (item::list, strm)
195 :     fun inputList (buf as IBUF{data, ...}, i, n) = let
196 :     val len = V.length data
197 :     val remain = len-i
198 :     in
199 :     if (remain >= n)
200 :     then ([vecExtract(data, i, SOME n)], ISTRM(buf, i+n))
201 :     else join (
202 :     vecExtract(data, i, NONE),
203 :     nextBuf(buf, n-remain))
204 :     end
205 :     and nextBuf (buf as IBUF{more, data, ...}, n) = (case !more
206 :     of (MORE buf) => inputList (buf, 0, n)
207 :     | (EOS buf) => ([], ISTRM(buf, 0))
208 :     | NOMORE => (
209 :     case extendStream (readVec buf, "inputN", buf)
210 :     of (MORE rest) => inputList (rest, 0, n)
211 :     | _ => ([], ISTRM(buf, V.length data))
212 :     (* end case *))
213 :     | TERMINATED => ([], ISTRM(buf, V.length data))
214 :     (* end case *))
215 :     val (data, strm) = inputList (buf, pos, n)
216 :     in
217 :     (V.concat data, strm)
218 :     end
219 :    
220 :     fun inputAll (strm as ISTRM(buf, _)) = let
221 :     val INFO{reader=PIO.RD{avail, ...}, ...} = infoOfIBuf buf
222 :     (* Read a chunk that is as large as the available input. *)
223 :     fun bigChunk _ = let
224 :     val delta = (case avail()
225 :     of NONE => chunkSzOfIBuf buf
226 :     | (SOME n) => n
227 :     (* end case *))
228 :     in
229 :     readChunk buf delta
230 :     end
231 :     val bigInput =
232 :     generalizedInput (getBuffer (bigChunk, "inputAll"))
233 :     fun loop (v, strm) = if (V.length v = 0)
234 :     then ([], strm)
235 :     else let val (l, strm') = loop(bigInput strm)
236 :     in
237 :     (v :: l, strm')
238 :     end
239 :     val (data, strm') = loop (bigInput strm)
240 :     in
241 :     (V.concat data, strm')
242 :     end
243 :     (* Return SOME k, if k <= amount characters can be read without blocking. *)
244 :     fun canInput (strm as ISTRM(buf, pos), amount) = let
245 :     val readVecNB = (case buf
246 :     of (IBUF{info as INFO{readVecNB=NONE, ...}, ...}) =>
247 :     inputExn(info, "canInput", IO.NonblockingNotSupported)
248 :     | (IBUF{info=INFO{readVecNB=SOME f, ...}, ...}) => f
249 :     (* end case *))
250 :     fun tryInput (buf as IBUF{data, ...}, i, n) = let
251 :     val len = V.length data
252 :     val remain = len - i
253 :     in
254 :     if (remain >= n)
255 :     then SOME n
256 :     else nextBuf (buf, n - remain)
257 :     end
258 :     and nextBuf (IBUF{more, ...}, n) = (case !more
259 :     of (MORE buf) => tryInput (buf, 0, n)
260 :     | (EOS _) => SOME(amount - n)
261 :     | TERMINATED => SOME(amount - n)
262 :     | NOMORE => ((
263 :     case extendStream (readVecNB, "canInput", buf)
264 :     of (MORE b) => tryInput (b, 0, n)
265 :     | _ => SOME(amount - n)
266 :     (* end case *))
267 :     handle IO.Io{cause=WouldBlock, ...} => SOME(amount - n))
268 :     (* end case *))
269 :     in
270 :     if (amount < 0)
271 :     then raise Size
272 :     else tryInput (buf, pos, amount)
273 :     end
274 :     fun closeIn (ISTRM(buf, _)) = (case (infoOfIBuf buf)
275 :     of INFO{closed=ref true, ...} => ()
276 :     | (info as INFO{closed, reader=PIO.RD{close, ...}, ...}) => (
277 :     terminate info;
278 :     closed := true;
279 :     close() handle ex => inputExn(info, "closeIn", ex))
280 :     (* end case *))
281 :     fun endOfStream (ISTRM(buf, pos)) = (case buf
282 :     of (IBUF{more=ref(MORE _), ...}) => false
283 :     | (IBUF{more, data, info=INFO{closed, ...}, ...}) =>
284 :     if (pos = V.length data)
285 :     then (case (!more, !closed)
286 :     of (NOMORE, false) => (
287 :     case extendStream (readVec buf, "endOfStream", buf)
288 :     of (EOS _) => true
289 :     | _ => false
290 :     (* end case *))
291 :     | _ => true
292 :     (* end case *))
293 :     else false
294 :     (* end case *))
295 :     fun mkInstream (reader, data) = let
296 :     val PIO.RD{readVec, readVecNB, getPos, setPos, ...} = reader
297 :     val readVec' = (case readVec
298 :     of NONE => (fn _ => raise IO.BlockingNotSupported)
299 :     | (SOME f) => f
300 :     (* end case *))
301 :     val readVecNB' = (case readVecNB
302 :     of NONE => NONE
303 :     | (SOME f) => SOME(fn arg => case (f arg)
304 :     of (SOME x) => x
305 :     | NONE => raise WouldBlock
306 :     (* end case *))
307 :     (* end case *))
308 :     val getPos = (case (getPos, setPos)
309 :     of (SOME f, SOME _) => (fn () => SOME(f()))
310 :     | _ => (fn () => NONE)
311 :     (* end case *))
312 :     val more = ref NOMORE
313 :     val closedFlg = ref false
314 :     val tag = CleanIO.addCleaner {
315 :     init = fn () => (closedFlg := true),
316 :     flush = fn () => (),
317 :     close = fn () => (closedFlg := true)
318 :     }
319 :     val info = INFO{
320 :     reader=reader, readVec=readVec', readVecNB=readVecNB',
321 :     closed = closedFlg, getPos = getPos, tail = ref more,
322 :     cleanTag = tag
323 :     }
324 :     (** What should we do about the position when there is initial data?? **)
325 :     (** Suggestion: When building a stream with supplied initial data,
326 :     ** nothing can be said about the positions inside that initial
327 :     ** data (who knows where that data even came from!).
328 :     **)
329 :     val basePos = if (V.length data = 0)
330 :     then getPos()
331 :     else NONE
332 :     in
333 :     ISTRM(
334 :     IBUF{basePos = basePos, data = data, info = info, more = more},
335 :     0)
336 :     end
337 :     fun getReader (ISTRM(buf, pos)) = let
338 :     val IBUF{data, info as INFO{reader, ...}, more, ...} = buf
339 :     fun getData (MORE(IBUF{data, more, ...})) = data :: getData(!more)
340 :     | getData _ = []
341 :     in
342 :     terminate info;
343 :     if (pos < V.length data)
344 :     then (
345 :     reader,
346 :     V.concat(vecExtract(data, pos, NONE) :: getData(!more))
347 :     )
348 :     else (reader, V.concat(getData(!more)))
349 :     end
350 :    
351 :     (* Get the underlying file position of a stream *)
352 :     fun filePosIn (ISTRM(buf, pos)) = (case buf
353 :     of IBUF{basePos=NONE, info, ...} =>
354 :     inputExn (info, "filePosIn", IO.RandomAccessNotSupported)
355 :     | IBUF{basePos=SOME b, info, ...} =>
356 :     Position.+(b, Position.fromInt pos)
357 :     (* end case *))
358 :    
359 :    
360 :     (*** Output streams ***)
361 :     datatype outstream = OSTRM of {
362 :     buf : A.array,
363 :     pos : int ref,
364 :     closed : bool ref,
365 :     bufferMode : IO.buffer_mode ref,
366 :     writer : writer,
367 : mblume 1381 writeArr : AS.slice -> unit,
368 :     writeVec : VS.slice -> unit,
369 : monnier 416 cleanTag : CleanIO.tag
370 :     }
371 :    
372 :     fun outputExn (OSTRM{writer=PIO.WR{name, ...}, ...}, mlOp, exn) =
373 :     raise IO.Io{function=mlOp, name=name, cause=exn}
374 :    
375 :     fun isClosedOut (strm as OSTRM{closed=ref true, ...}, mlOp) =
376 :     outputExn (strm, mlOp, IO.ClosedStream)
377 :     | isClosedOut _ = ()
378 :    
379 :     fun flushBuffer (strm as OSTRM{buf, pos, writeArr, ...}, mlOp) = (
380 :     case !pos
381 :     of 0 => ()
382 :     | n => ((
383 : mblume 1381 writeArr (AS.slice (buf, 0, SOME n)); pos := 0)
384 : monnier 416 handle ex => outputExn (strm, mlOp, ex))
385 :     (* end case *))
386 :    
387 :     fun output (strm as OSTRM os, v) = let
388 :     val _ = isClosedOut (strm, "output")
389 :     val {buf, pos, bufferMode, ...} = os
390 :     fun flush () = flushBuffer (strm, "output")
391 : mblume 1381 fun flushAll () = (#writeArr os (AS.full buf)
392 : monnier 416 handle ex => outputExn (strm, "output", ex))
393 :     fun writeDirect () = (
394 :     case !pos
395 :     of 0 => ()
396 : mblume 1381 | n => (#writeArr os (AS.slice (buf, 0, SOME n));
397 :     pos := 0)
398 : monnier 416 (* end case *);
399 : mblume 1381 #writeVec os (VS.full v))
400 : monnier 416 handle ex => outputExn (strm, "output", ex)
401 :     fun insert copyVec = let
402 :     val bufLen = A.length buf
403 :     val dataLen = V.length v
404 :     in
405 :     if (dataLen >= bufLen)
406 :     then writeDirect()
407 :     else let
408 :     val i = !pos
409 :     val avail = bufLen - i
410 :     in
411 :     if (avail < dataLen)
412 :     then (
413 :     copyVec(v, 0, avail, buf, i);
414 :     flushAll();
415 :     copyVec(v, avail, dataLen-avail, buf, 0);
416 :     pos := dataLen-avail)
417 :     else (
418 :     copyVec(v, 0, dataLen, buf, i);
419 :     pos := i + dataLen;
420 :     if (avail = dataLen) then flush() else ())
421 :     end
422 :     end
423 :     in
424 :     case !bufferMode
425 :     of IO.NO_BUF => writeDirect ()
426 :     | _ => let
427 : mblume 1350 fun copyVec (src, srcI, srcLen, dst, dstI) =
428 :     AS.copyVec { src = VS.slice (src, srcI, SOME srcLen),
429 :     dst = dst, di = dstI }
430 : monnier 416 in
431 :     insert copyVec
432 :     end
433 :     (* end case *)
434 :     end
435 :    
436 :     fun output1 (strm as OSTRM{buf, pos, bufferMode, writeArr, ...}, elem) = (
437 :     isClosedOut (strm, "output1");
438 :     case !bufferMode
439 :     of IO.NO_BUF => (
440 :     arrUpdate (buf, 0, elem);
441 : mblume 1381 writeArr (AS.slice (buf, 0, SOME 1))
442 : monnier 416 handle ex => outputExn (strm, "output1", ex))
443 :     | _ => let val i = !pos val i' = i+1
444 :     in
445 :     arrUpdate (buf, i, elem); pos := i';
446 :     if (i' = A.length buf)
447 :     then flushBuffer (strm, "output1")
448 :     else ()
449 :     end
450 :     (* end case *))
451 :    
452 :     fun flushOut strm = (
453 :     flushBuffer (strm, "flushOut"))
454 :    
455 :     fun closeOut (strm as OSTRM{writer=PIO.WR{close, ...}, closed, cleanTag, ...}) =
456 :     if !closed
457 :     then ()
458 :     else (
459 :     flushBuffer (strm, "closeOut");
460 :     closed := true;
461 :     CleanIO.removeCleaner cleanTag;
462 :     close())
463 :    
464 :     fun mkOutstream (wr as PIO.WR{chunkSize, writeArr, writeVec, ...}, mode) =
465 :     let
466 : mblume 1381 fun iterate (f, size, subslice) = let
467 :     fun lp sl =
468 :     if size sl = 0 then ()
469 :     else let val n = f sl
470 :     in
471 :     lp (subslice (sl, n, NONE))
472 :     end
473 :     in
474 :     lp
475 :     end
476 : monnier 416 val writeArr' = (case writeArr
477 :     of NONE => (fn _ => raise IO.BlockingNotSupported)
478 : mblume 1381 | (SOME f) => iterate (f, AS.length, AS.subslice)
479 : monnier 416 (* end case *))
480 :     val writeVec' = (case writeVec
481 :     of NONE => (fn _ => raise IO.BlockingNotSupported)
482 : mblume 1381 | (SOME f) => iterate (f, VS.length, VS.subslice)
483 : monnier 416 (* end case *))
484 :     (* install a dummy cleaner *)
485 :     val tag = CleanIO.addCleaner {
486 :     init = fn () => (),
487 :     flush = fn () => (),
488 :     close = fn () => ()
489 :     }
490 :     val strm = OSTRM{
491 :     buf = A.array(chunkSize, someElem),
492 :     pos = ref 0,
493 :     closed = ref false,
494 :     bufferMode = ref mode,
495 :     writer = wr,
496 :     writeArr = writeArr',
497 :     writeVec = writeVec',
498 :     cleanTag = tag
499 :     }
500 :     in
501 :     CleanIO.rebindCleaner (tag, {
502 :     init = fn () => closeOut strm,
503 :     flush = fn () => flushOut strm,
504 :     close = fn () => closeOut strm
505 :     });
506 :     strm
507 :     end
508 :    
509 :     fun getWriter (strm as OSTRM{writer, bufferMode, ...}) = (
510 :     flushBuffer (strm, "getWriter");
511 :     (writer, !bufferMode))
512 :    
513 :     (** Position operations on outstreams **)
514 :     datatype out_pos = OUTP of {
515 :     pos : PIO.pos,
516 :     strm : outstream
517 :     }
518 :    
519 :     fun getPosOut (strm as OSTRM{writer, ...}) = (
520 :     flushBuffer (strm, "getPosOut");
521 :     case writer
522 :     of PIO.WR{getPos=SOME f, ...} => (
523 :     OUTP{pos = f(), strm = strm}
524 :     handle ex => outputExn(strm, "getPosOut", ex))
525 :     | _ => outputExn(strm, "getPosOut", IO.RandomAccessNotSupported)
526 :     (* end case *))
527 :     fun filePosOut (OUTP{pos, strm}) = (
528 :     isClosedOut (strm, "filePosOut"); pos)
529 :     fun setPosOut (OUTP{pos, strm as OSTRM{writer, ...}}) = (
530 :     isClosedOut (strm, "setPosOut");
531 :     case writer
532 :     of PIO.WR{setPos=SOME f, ...} => (
533 :     (f pos)
534 :     handle ex => outputExn(strm, "setPosOut", ex))
535 :     | _ => outputExn(strm, "getPosOut", IO.RandomAccessNotSupported)
536 :     (* end case *))
537 :    
538 :     fun setBufferMode (strm as OSTRM{bufferMode, ...}, IO.NO_BUF) = (
539 :     flushBuffer (strm, "setBufferMode");
540 :     bufferMode := IO.NO_BUF)
541 :     | setBufferMode (strm as OSTRM{bufferMode, ...}, mode) = (
542 :     isClosedOut (strm, "setBufferMode");
543 :     bufferMode := mode)
544 :     fun getBufferMode (strm as OSTRM{bufferMode, ...}) = (
545 :     isClosedOut (strm, "getBufferMode");
546 :     !bufferMode)
547 :    
548 :     end (* StreamIO *)
549 :    
550 :     type vector = V.vector
551 :     type elem = V.elem
552 :     type instream = StreamIO.instream ref
553 :     type outstream = StreamIO.outstream ref
554 :    
555 :     (** Input operations **)
556 :     fun input strm = let val (v, strm') = StreamIO.input(!strm)
557 :     in
558 :     strm := strm'; v
559 :     end
560 :     fun input1 strm = (case StreamIO.input1(!strm)
561 :     of NONE => NONE
562 :     | (SOME(elem, strm')) => (strm := strm'; SOME elem)
563 :     (* end case *))
564 :     fun inputN (strm, n) = let val (v, strm') = StreamIO.inputN (!strm, n)
565 :     in
566 :     strm := strm'; v
567 :     end
568 :     fun inputAll (strm : instream) = let
569 :     val (v, s) = StreamIO.inputAll(!strm)
570 :     in
571 :     strm := s; v
572 :     end
573 :     fun canInput (strm, n) = StreamIO.canInput (!strm, n)
574 :     fun lookahead (strm : instream) = (case StreamIO.input1(!strm)
575 :     of NONE => NONE
576 :     | (SOME(elem, _)) => SOME elem
577 :     (* end case *))
578 :     fun closeIn strm = let
579 :     val (s as StreamIO.ISTRM(buf as StreamIO.IBUF{data, ...}, _)) = !strm
580 :     (* find the end of the stream *)
581 :     fun findEOS (StreamIO.IBUF{more=ref(StreamIO.MORE buf), ...}) =
582 :     findEOS buf
583 :     | findEOS (StreamIO.IBUF{more=ref(StreamIO.EOS buf), ...}) =
584 :     findEOS buf
585 :     | findEOS (buf as StreamIO.IBUF{data, ...}) =
586 :     StreamIO.ISTRM(buf, V.length data)
587 :     in
588 :     StreamIO.closeIn s;
589 :     strm := findEOS buf
590 :     end
591 :     fun endOfStream strm = StreamIO.endOfStream(! strm)
592 :    
593 :     (** Output operations **)
594 :     fun output (strm, v) = StreamIO.output(!strm, v)
595 :     fun output1 (strm, c) = StreamIO.output1(!strm, c)
596 :     fun flushOut strm = StreamIO.flushOut(!strm)
597 :     fun closeOut strm = StreamIO.closeOut(!strm)
598 :     fun getPosOut strm = StreamIO.getPosOut(!strm)
599 :     fun setPosOut (strm, p as StreamIO.OUTP{strm=strm', ...}) = (
600 :     strm := strm'; StreamIO.setPosOut p)
601 :    
602 :     fun mkInstream (strm : StreamIO.instream) = ref strm
603 :     fun getInstream (strm : instream) = !strm
604 :     fun setInstream (strm : instream, strm') = strm := strm'
605 :    
606 :     fun mkOutstream (strm : StreamIO.outstream) = ref strm
607 :     fun getOutstream (strm : outstream) = !strm
608 :     fun setOutstream (strm : outstream, strm') = strm := strm'
609 :    
610 :     (** Open files **)
611 :     fun openIn fname =
612 : jhr 2849 mkInstream(StreamIO.mkInstream(PIO.openRd fname, empty))
613 : monnier 416 handle ex => raise IO.Io{function="openIn", name=fname, cause=ex}
614 :     fun openOut fname =
615 : jhr 2849 mkOutstream(StreamIO.mkOutstream(PIO.openWr fname, IO.BLOCK_BUF))
616 : monnier 416 handle ex => raise IO.Io{function="openOut", name=fname, cause=ex}
617 :     fun openAppend fname =
618 : jhr 2849 mkOutstream(StreamIO.mkOutstream(PIO.openApp fname, IO.NO_BUF))
619 : monnier 416 handle ex => raise IO.Io{function="openAppend", name=fname, cause=ex}
620 :    
621 :     end (* BinIOFn *)
622 :     end
623 :    

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0