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/trunk/src/system/Basis/Implementation/IO/bin-io-fn.sml
ViewVC logotype

Annotation of /sml/trunk/src/system/Basis/Implementation/IO/bin-io-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 499 - (view) (download)

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

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