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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 416 - (view) (download)
Original Path: sml/trunk/src/system/Basis/Implementation/IO/bin-io-fn.sml

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 :     (* end case *))
175 :    
176 :     fun input (strm as ISTRM(buf, _)) =
177 :     generalizedInput (getBuffer (readVec buf, "input")) strm
178 :     fun input1 (ISTRM(buf, pos)) = let
179 :     val IBUF{data, more, ...} = buf
180 :     in
181 :     if (pos < V.length data)
182 :     then SOME(vecSub(data, pos), ISTRM(buf, pos+1))
183 :     else (case !more
184 :     of (MORE buf) => input1 (ISTRM(buf, 0))
185 :     | (EOS _) => NONE
186 :     | NOMORE => (
187 :     case extendStream (readVec buf, "input1", buf)
188 :     of (MORE rest) => input1 (ISTRM(rest, 0))
189 :     | _ => NONE
190 :     (* end case *))
191 :     | TERMINATED => NONE
192 :     (* end case *))
193 :     end
194 :     fun inputN (ISTRM(buf, pos), n) = let
195 :     fun join (item, (list, strm)) = (item::list, strm)
196 :     fun inputList (buf as IBUF{data, ...}, i, n) = let
197 :     val len = V.length data
198 :     val remain = len-i
199 :     in
200 :     if (remain >= n)
201 :     then ([vecExtract(data, i, SOME n)], ISTRM(buf, i+n))
202 :     else join (
203 :     vecExtract(data, i, NONE),
204 :     nextBuf(buf, n-remain))
205 :     end
206 :     and nextBuf (buf as IBUF{more, data, ...}, n) = (case !more
207 :     of (MORE buf) => inputList (buf, 0, n)
208 :     | (EOS buf) => ([], ISTRM(buf, 0))
209 :     | NOMORE => (
210 :     case extendStream (readVec buf, "inputN", buf)
211 :     of (MORE rest) => inputList (rest, 0, n)
212 :     | _ => ([], ISTRM(buf, V.length data))
213 :     (* end case *))
214 :     | TERMINATED => ([], ISTRM(buf, V.length data))
215 :     (* end case *))
216 :     val (data, strm) = inputList (buf, pos, n)
217 :     in
218 :     (V.concat data, strm)
219 :     end
220 :    
221 :     fun inputAll (strm as ISTRM(buf, _)) = let
222 :     val INFO{reader=PIO.RD{avail, ...}, ...} = infoOfIBuf buf
223 :     (* Read a chunk that is as large as the available input. *)
224 :     fun bigChunk _ = let
225 :     val delta = (case avail()
226 :     of NONE => chunkSzOfIBuf buf
227 :     | (SOME n) => n
228 :     (* end case *))
229 :     in
230 :     readChunk buf delta
231 :     end
232 :     val bigInput =
233 :     generalizedInput (getBuffer (bigChunk, "inputAll"))
234 :     fun loop (v, strm) = if (V.length v = 0)
235 :     then ([], strm)
236 :     else let val (l, strm') = loop(bigInput strm)
237 :     in
238 :     (v :: l, strm')
239 :     end
240 :     val (data, strm') = loop (bigInput strm)
241 :     in
242 :     (V.concat data, strm')
243 :     end
244 :     (* Return SOME k, if k <= amount characters can be read without blocking. *)
245 :     fun canInput (strm as ISTRM(buf, pos), amount) = let
246 :     val readVecNB = (case buf
247 :     of (IBUF{info as INFO{readVecNB=NONE, ...}, ...}) =>
248 :     inputExn(info, "canInput", IO.NonblockingNotSupported)
249 :     | (IBUF{info=INFO{readVecNB=SOME f, ...}, ...}) => f
250 :     (* end case *))
251 :     fun tryInput (buf as IBUF{data, ...}, i, n) = let
252 :     val len = V.length data
253 :     val remain = len - i
254 :     in
255 :     if (remain >= n)
256 :     then SOME n
257 :     else nextBuf (buf, n - remain)
258 :     end
259 :     and nextBuf (IBUF{more, ...}, n) = (case !more
260 :     of (MORE buf) => tryInput (buf, 0, n)
261 :     | (EOS _) => SOME(amount - n)
262 :     | TERMINATED => SOME(amount - n)
263 :     | NOMORE => ((
264 :     case extendStream (readVecNB, "canInput", buf)
265 :     of (MORE b) => tryInput (b, 0, n)
266 :     | _ => SOME(amount - n)
267 :     (* end case *))
268 :     handle IO.Io{cause=WouldBlock, ...} => SOME(amount - n))
269 :     (* end case *))
270 :     in
271 :     if (amount < 0)
272 :     then raise Size
273 :     else tryInput (buf, pos, amount)
274 :     end
275 :     fun closeIn (ISTRM(buf, _)) = (case (infoOfIBuf buf)
276 :     of INFO{closed=ref true, ...} => ()
277 :     | (info as INFO{closed, reader=PIO.RD{close, ...}, ...}) => (
278 :     terminate info;
279 :     closed := true;
280 :     close() handle ex => inputExn(info, "closeIn", ex))
281 :     (* end case *))
282 :     fun endOfStream (ISTRM(buf, pos)) = (case buf
283 :     of (IBUF{more=ref(MORE _), ...}) => false
284 :     | (IBUF{more=ref(EOS _), ...}) => true
285 :     | (IBUF{more, data, info=INFO{closed, ...}, ...}) =>
286 :     if (pos = V.length data)
287 :     then (case (!more, !closed)
288 :     of (NOMORE, false) => (
289 :     case extendStream (readVec buf, "endOfStream", buf)
290 :     of (EOS _) => true
291 :     | _ => false
292 :     (* end case *))
293 :     | _ => true
294 :     (* end case *))
295 :     else false
296 :     (* end case *))
297 :     fun mkInstream (reader, data) = let
298 :     val PIO.RD{readVec, readVecNB, getPos, setPos, ...} = reader
299 :     val readVec' = (case readVec
300 :     of NONE => (fn _ => raise IO.BlockingNotSupported)
301 :     | (SOME f) => f
302 :     (* end case *))
303 :     val readVecNB' = (case readVecNB
304 :     of NONE => NONE
305 :     | (SOME f) => SOME(fn arg => case (f arg)
306 :     of (SOME x) => x
307 :     | NONE => raise WouldBlock
308 :     (* end case *))
309 :     (* end case *))
310 :     val getPos = (case (getPos, setPos)
311 :     of (SOME f, SOME _) => (fn () => SOME(f()))
312 :     | _ => (fn () => NONE)
313 :     (* end case *))
314 :     val more = ref NOMORE
315 :     val closedFlg = ref false
316 :     val tag = CleanIO.addCleaner {
317 :     init = fn () => (closedFlg := true),
318 :     flush = fn () => (),
319 :     close = fn () => (closedFlg := true)
320 :     }
321 :     val info = INFO{
322 :     reader=reader, readVec=readVec', readVecNB=readVecNB',
323 :     closed = closedFlg, getPos = getPos, tail = ref more,
324 :     cleanTag = tag
325 :     }
326 :     (** What should we do about the position when there is initial data?? **)
327 :     (** Suggestion: When building a stream with supplied initial data,
328 :     ** nothing can be said about the positions inside that initial
329 :     ** data (who knows where that data even came from!).
330 :     **)
331 :     val basePos = if (V.length data = 0)
332 :     then getPos()
333 :     else NONE
334 :     in
335 :     ISTRM(
336 :     IBUF{basePos = basePos, data = data, info = info, more = more},
337 :     0)
338 :     end
339 :     fun getReader (ISTRM(buf, pos)) = let
340 :     val IBUF{data, info as INFO{reader, ...}, more, ...} = buf
341 :     fun getData (MORE(IBUF{data, more, ...})) = data :: getData(!more)
342 :     | getData _ = []
343 :     in
344 :     terminate info;
345 :     if (pos < V.length data)
346 :     then (
347 :     reader,
348 :     V.concat(vecExtract(data, pos, NONE) :: getData(!more))
349 :     )
350 :     else (reader, V.concat(getData(!more)))
351 :     end
352 :    
353 :     (* Get the underlying file position of a stream *)
354 :     fun filePosIn (ISTRM(buf, pos)) = (case buf
355 :     of IBUF{basePos=NONE, info, ...} =>
356 :     inputExn (info, "filePosIn", IO.RandomAccessNotSupported)
357 :     | IBUF{basePos=SOME b, info, ...} =>
358 :     Position.+(b, Position.fromInt pos)
359 :     (* end case *))
360 :    
361 :    
362 :     (*** Output streams ***)
363 :     datatype outstream = OSTRM of {
364 :     buf : A.array,
365 :     pos : int ref,
366 :     closed : bool ref,
367 :     bufferMode : IO.buffer_mode ref,
368 :     writer : writer,
369 :     writeArr : {buf : A.array, i : int, sz : int option} -> unit,
370 :     writeVec : {buf : V.vector, i : int, sz : int option} -> unit,
371 :     cleanTag : CleanIO.tag
372 :     }
373 :    
374 :     fun outputExn (OSTRM{writer=PIO.WR{name, ...}, ...}, mlOp, exn) =
375 :     raise IO.Io{function=mlOp, name=name, cause=exn}
376 :    
377 :     fun isClosedOut (strm as OSTRM{closed=ref true, ...}, mlOp) =
378 :     outputExn (strm, mlOp, IO.ClosedStream)
379 :     | isClosedOut _ = ()
380 :    
381 :     fun flushBuffer (strm as OSTRM{buf, pos, writeArr, ...}, mlOp) = (
382 :     case !pos
383 :     of 0 => ()
384 :     | n => ((
385 :     writeArr {buf=buf, i=0, sz=SOME n}; pos := 0)
386 :     handle ex => outputExn (strm, mlOp, ex))
387 :     (* end case *))
388 :    
389 :     fun output (strm as OSTRM os, v) = let
390 :     val _ = isClosedOut (strm, "output")
391 :     val {buf, pos, bufferMode, ...} = os
392 :     fun flush () = flushBuffer (strm, "output")
393 :     fun flushAll () = (#writeArr os {buf=buf, i=0, sz=NONE}
394 :     handle ex => outputExn (strm, "output", ex))
395 :     fun writeDirect () = (
396 :     case !pos
397 :     of 0 => ()
398 :     | n => (#writeArr os {buf=buf, i=0, sz=SOME n}; pos := 0)
399 :     (* end case *);
400 :     #writeVec os {buf=v, i=0, sz=NONE})
401 :     handle ex => outputExn (strm, "output", ex)
402 :     fun insert copyVec = let
403 :     val bufLen = A.length buf
404 :     val dataLen = V.length v
405 :     in
406 :     if (dataLen >= bufLen)
407 :     then writeDirect()
408 :     else let
409 :     val i = !pos
410 :     val avail = bufLen - i
411 :     in
412 :     if (avail < dataLen)
413 :     then (
414 :     copyVec(v, 0, avail, buf, i);
415 :     flushAll();
416 :     copyVec(v, avail, dataLen-avail, buf, 0);
417 :     pos := dataLen-avail)
418 :     else (
419 :     copyVec(v, 0, dataLen, buf, i);
420 :     pos := i + dataLen;
421 :     if (avail = dataLen) then flush() else ())
422 :     end
423 :     end
424 :     in
425 :     case !bufferMode
426 :     of IO.NO_BUF => writeDirect ()
427 :     | _ => let
428 :     fun copyVec (src, srcI, srcLen, dst, dstI) = A.copyVec {
429 :     src = src, si = srcI, len = SOME srcLen,
430 :     dst = dst, di = dstI
431 :     }
432 :     in
433 :     insert copyVec
434 :     end
435 :     (* end case *)
436 :     end
437 :    
438 :     fun output1 (strm as OSTRM{buf, pos, bufferMode, writeArr, ...}, elem) = (
439 :     isClosedOut (strm, "output1");
440 :     case !bufferMode
441 :     of IO.NO_BUF => (
442 :     arrUpdate (buf, 0, elem);
443 :     writeArr {buf=buf, i=0, sz=SOME 1}
444 :     handle ex => outputExn (strm, "output1", ex))
445 :     | _ => let val i = !pos val i' = i+1
446 :     in
447 :     arrUpdate (buf, i, elem); pos := i';
448 :     if (i' = A.length buf)
449 :     then flushBuffer (strm, "output1")
450 :     else ()
451 :     end
452 :     (* end case *))
453 :    
454 :     fun flushOut strm = (
455 :     flushBuffer (strm, "flushOut"))
456 :    
457 :     fun closeOut (strm as OSTRM{writer=PIO.WR{close, ...}, closed, cleanTag, ...}) =
458 :     if !closed
459 :     then ()
460 :     else (
461 :     flushBuffer (strm, "closeOut");
462 :     closed := true;
463 :     CleanIO.removeCleaner cleanTag;
464 :     close())
465 :    
466 :     fun mkOutstream (wr as PIO.WR{chunkSize, writeArr, writeVec, ...}, mode) =
467 :     let
468 :     fun iterate f (buf, i, sz) = let
469 :     fun lp (_, 0) = ()
470 :     | lp (i, n) = let val n' = f{buf=buf, i=i, sz=SOME n}
471 :     in lp (i+n', n-n') end
472 :     in
473 :     lp (i, sz)
474 :     end
475 :     val writeArr' = (case writeArr
476 :     of NONE => (fn _ => raise IO.BlockingNotSupported)
477 :     | (SOME f) => let
478 :     fun write {buf, i, sz} = let
479 :     val len = (case sz
480 :     of NONE => A.length buf - i
481 :     | (SOME n) => n
482 :     (* end case *))
483 :     in
484 :     iterate f (buf, i, len)
485 :     end
486 :     in
487 :     write
488 :     end
489 :     (* end case *))
490 :     val writeVec' = (case writeVec
491 :     of NONE => (fn _ => raise IO.BlockingNotSupported)
492 :     | (SOME f) => let
493 :     fun write {buf, i, sz} = let
494 :     val len = (case sz
495 :     of NONE => V.length buf - i
496 :     | (SOME n) => n
497 :     (* end case *))
498 :     in
499 :     iterate f (buf, i, len)
500 :     end
501 :     in
502 :     write
503 :     end
504 :     (* end case *))
505 :     (* install a dummy cleaner *)
506 :     val tag = CleanIO.addCleaner {
507 :     init = fn () => (),
508 :     flush = fn () => (),
509 :     close = fn () => ()
510 :     }
511 :     val strm = OSTRM{
512 :     buf = A.array(chunkSize, someElem),
513 :     pos = ref 0,
514 :     closed = ref false,
515 :     bufferMode = ref mode,
516 :     writer = wr,
517 :     writeArr = writeArr',
518 :     writeVec = writeVec',
519 :     cleanTag = tag
520 :     }
521 :     in
522 :     CleanIO.rebindCleaner (tag, {
523 :     init = fn () => closeOut strm,
524 :     flush = fn () => flushOut strm,
525 :     close = fn () => closeOut strm
526 :     });
527 :     strm
528 :     end
529 :    
530 :     fun getWriter (strm as OSTRM{writer, bufferMode, ...}) = (
531 :     flushBuffer (strm, "getWriter");
532 :     (writer, !bufferMode))
533 :    
534 :     (** Position operations on outstreams **)
535 :     datatype out_pos = OUTP of {
536 :     pos : PIO.pos,
537 :     strm : outstream
538 :     }
539 :    
540 :     fun getPosOut (strm as OSTRM{writer, ...}) = (
541 :     flushBuffer (strm, "getPosOut");
542 :     case writer
543 :     of PIO.WR{getPos=SOME f, ...} => (
544 :     OUTP{pos = f(), strm = strm}
545 :     handle ex => outputExn(strm, "getPosOut", ex))
546 :     | _ => outputExn(strm, "getPosOut", IO.RandomAccessNotSupported)
547 :     (* end case *))
548 :     fun filePosOut (OUTP{pos, strm}) = (
549 :     isClosedOut (strm, "filePosOut"); pos)
550 :     fun setPosOut (OUTP{pos, strm as OSTRM{writer, ...}}) = (
551 :     isClosedOut (strm, "setPosOut");
552 :     case writer
553 :     of PIO.WR{setPos=SOME f, ...} => (
554 :     (f pos)
555 :     handle ex => outputExn(strm, "setPosOut", ex))
556 :     | _ => outputExn(strm, "getPosOut", IO.RandomAccessNotSupported)
557 :     (* end case *))
558 :    
559 :     fun setBufferMode (strm as OSTRM{bufferMode, ...}, IO.NO_BUF) = (
560 :     flushBuffer (strm, "setBufferMode");
561 :     bufferMode := IO.NO_BUF)
562 :     | setBufferMode (strm as OSTRM{bufferMode, ...}, mode) = (
563 :     isClosedOut (strm, "setBufferMode");
564 :     bufferMode := mode)
565 :     fun getBufferMode (strm as OSTRM{bufferMode, ...}) = (
566 :     isClosedOut (strm, "getBufferMode");
567 :     !bufferMode)
568 :    
569 :     end (* StreamIO *)
570 :    
571 :     type vector = V.vector
572 :     type elem = V.elem
573 :     type instream = StreamIO.instream ref
574 :     type outstream = StreamIO.outstream ref
575 :    
576 :     (** Input operations **)
577 :     fun input strm = let val (v, strm') = StreamIO.input(!strm)
578 :     in
579 :     strm := strm'; v
580 :     end
581 :     fun input1 strm = (case StreamIO.input1(!strm)
582 :     of NONE => NONE
583 :     | (SOME(elem, strm')) => (strm := strm'; SOME elem)
584 :     (* end case *))
585 :     fun inputN (strm, n) = let val (v, strm') = StreamIO.inputN (!strm, n)
586 :     in
587 :     strm := strm'; v
588 :     end
589 :     fun inputAll (strm : instream) = let
590 :     val (v, s) = StreamIO.inputAll(!strm)
591 :     in
592 :     strm := s; v
593 :     end
594 :     fun canInput (strm, n) = StreamIO.canInput (!strm, n)
595 :     fun lookahead (strm : instream) = (case StreamIO.input1(!strm)
596 :     of NONE => NONE
597 :     | (SOME(elem, _)) => SOME elem
598 :     (* end case *))
599 :     fun closeIn strm = let
600 :     val (s as StreamIO.ISTRM(buf as StreamIO.IBUF{data, ...}, _)) = !strm
601 :     (* find the end of the stream *)
602 :     fun findEOS (StreamIO.IBUF{more=ref(StreamIO.MORE buf), ...}) =
603 :     findEOS buf
604 :     | findEOS (StreamIO.IBUF{more=ref(StreamIO.EOS buf), ...}) =
605 :     findEOS buf
606 :     | findEOS (buf as StreamIO.IBUF{data, ...}) =
607 :     StreamIO.ISTRM(buf, V.length data)
608 :     in
609 :     StreamIO.closeIn s;
610 :     strm := findEOS buf
611 :     end
612 :     fun endOfStream strm = StreamIO.endOfStream(! strm)
613 :    
614 :     (** Output operations **)
615 :     fun output (strm, v) = StreamIO.output(!strm, v)
616 :     fun output1 (strm, c) = StreamIO.output1(!strm, c)
617 :     fun flushOut strm = StreamIO.flushOut(!strm)
618 :     fun closeOut strm = StreamIO.closeOut(!strm)
619 :     fun getPosOut strm = StreamIO.getPosOut(!strm)
620 :     fun setPosOut (strm, p as StreamIO.OUTP{strm=strm', ...}) = (
621 :     strm := strm'; StreamIO.setPosOut p)
622 :    
623 :     fun mkInstream (strm : StreamIO.instream) = ref strm
624 :     fun getInstream (strm : instream) = !strm
625 :     fun setInstream (strm : instream, strm') = strm := strm'
626 :    
627 :     fun mkOutstream (strm : StreamIO.outstream) = ref strm
628 :     fun getOutstream (strm : outstream) = !strm
629 :     fun setOutstream (strm : outstream, strm') = strm := strm'
630 :    
631 :     (** Open files **)
632 :     fun openIn fname =
633 :     mkInstream(StreamIO.mkInstream(OSPrimIO.openRd fname, empty))
634 :     handle ex => raise IO.Io{function="openIn", name=fname, cause=ex}
635 :     fun openOut fname =
636 :     mkOutstream(StreamIO.mkOutstream(OSPrimIO.openWr fname, IO.BLOCK_BUF))
637 :     handle ex => raise IO.Io{function="openOut", name=fname, cause=ex}
638 :     fun openAppend fname =
639 :     mkOutstream(StreamIO.mkOutstream(OSPrimIO.openApp fname, IO.NO_BUF))
640 :     handle ex => raise IO.Io{function="openAppend", name=fname, cause=ex}
641 :    
642 :     end (* BinIOFn *)
643 :     end
644 :    

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