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/text-io.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2849 - (view) (download)

1 : jhr 2849 (* text-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 OS = OSImp
14 :     in
15 : jhr 2849 structure TextIO : TEXT_IO = struct
16 : monnier 416
17 : jhr 2849 structure PIO = TextPrimIO
18 : monnier 416 structure A = CharArray
19 :     structure V = CharVector
20 : mblume 1350 structure AS = CharArraySlice
21 :     structure VS = CharVectorSlice
22 : monnier 416
23 :     (* an element for initializing buffers *)
24 :     val someElem = #"\000"
25 :    
26 :     (** Fast, but unsafe version (from CharVector) **
27 :     val vecSub = InlineT.CharVector.sub
28 :     val arrUpdate = InlineT.CharArray.update
29 :     (* fast vector extract operation. This should never be called with
30 :     * a length of 0.
31 :     *)
32 :     fun vecExtract (v, base, optLen) = let
33 :     val len = V.length v
34 :     fun newVec n = let
35 :     val newV = Assembly.A.create_s n
36 :     fun fill i = if (i < n)
37 :     then (
38 :     InlineT.CharVector.update(newV, i, vecSub(v, base+i));
39 :     fill(i+1))
40 :     else ()
41 :     in
42 :     fill 0; newV
43 :     end
44 :     in
45 :     case (base, optLen)
46 :     of (0, NONE) => v
47 :     | (_, NONE) => newVec (len - base)
48 :     | (_, SOME n) => newVec n
49 :     (* end case *)
50 :     end
51 :     **)
52 : mblume 1350 val vecExtract = VS.vector o VS.slice
53 : monnier 416 val vecSub = V.sub
54 :     val arrUpdate = A.update
55 :     val substringBase = Substring.base
56 :     val empty = ""
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 :    
167 :     (* terminate an input stream *)
168 :     fun terminate (INFO{tail, cleanTag, ...}) = (case !tail
169 :     of (m as ref NOMORE) => (
170 :     CleanIO.removeCleaner cleanTag;
171 :     m := TERMINATED)
172 :     | (m as ref TERMINATED) => ()
173 : monnier 498 | _ => raise Match (* shut up compiler *)
174 : monnier 416 (* 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 :     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. Note
223 :     * that for systems that use CR-LF for #"\n", the size will be
224 :     * too large, but this should be okay.
225 :     *)
226 :     fun bigChunk _ = let
227 :     val delta = (case avail()
228 :     of NONE => chunkSzOfIBuf buf
229 :     | (SOME n) => n
230 :     (* end case *))
231 :     in
232 :     readChunk buf delta
233 :     end
234 :     val bigInput =
235 :     generalizedInput (getBuffer (bigChunk, "inputAll"))
236 :     fun loop (v, strm) = if (V.length v = 0)
237 :     then ([], strm)
238 :     else let val (l, strm') = loop(bigInput strm)
239 :     in
240 :     (v :: l, strm')
241 :     end
242 :     val (data, strm') = loop (bigInput strm)
243 :     in
244 :     (V.concat data, strm')
245 :     end
246 :     (* Return SOME k, if k <= amount characters can be read without blocking. *)
247 :     fun canInput (strm as ISTRM(buf, pos), amount) = let
248 :     val readVecNB = (case buf
249 :     of (IBUF{info as INFO{readVecNB=NONE, ...}, ...}) =>
250 :     inputExn(info, "canInput", IO.NonblockingNotSupported)
251 :     | (IBUF{info=INFO{readVecNB=SOME f, ...}, ...}) => f
252 :     (* end case *))
253 :     fun tryInput (buf as IBUF{data, ...}, i, n) = let
254 :     val len = V.length data
255 :     val remain = len - i
256 :     in
257 :     if (remain >= n)
258 :     then SOME n
259 :     else nextBuf (buf, n - remain)
260 :     end
261 :     and nextBuf (IBUF{more, ...}, n) = (case !more
262 :     of (MORE buf) => tryInput (buf, 0, n)
263 :     | (EOS _) => SOME(amount - n)
264 :     | TERMINATED => SOME(amount - n)
265 :     | NOMORE => ((
266 :     case extendStream (readVecNB, "canInput", buf)
267 :     of (MORE b) => tryInput (b, 0, n)
268 :     | _ => SOME(amount - n)
269 :     (* end case *))
270 :     handle IO.Io{cause=WouldBlock, ...} => SOME(amount - n))
271 :     (* end case *))
272 :     in
273 :     if (amount < 0)
274 :     then raise Size
275 :     else tryInput (buf, pos, amount)
276 :     end
277 :     fun closeIn (ISTRM(buf, _)) = (case (infoOfIBuf buf)
278 :     of INFO{closed=ref true, ...} => ()
279 :     | (info as INFO{closed, reader=PIO.RD{close, ...}, ...}) => (
280 :     terminate info;
281 :     closed := true;
282 :     close() handle ex => inputExn(info, "closeIn", ex))
283 :     (* end case *))
284 :     fun endOfStream (ISTRM(buf, pos)) = (case buf
285 :     of (IBUF{more=ref(MORE _), ...}) => false
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 :    
341 :     fun getReader (ISTRM(buf, pos)) = let
342 :     val IBUF{data, info as INFO{reader, ...}, more, ...} = buf
343 :     fun getData (MORE(IBUF{data, more, ...})) = data :: getData(!more)
344 :     | getData _ = []
345 :     in
346 :     terminate info;
347 :     if (pos < V.length data)
348 :     then (
349 :     reader,
350 :     V.concat(vecExtract(data, pos, NONE) :: getData(!more))
351 :     )
352 :     else (reader, V.concat(getData(!more)))
353 :     end
354 :    
355 :     (* Get the underlying file position of a stream *)
356 :     fun filePosIn (ISTRM(buf, pos)) = (case buf
357 :     of IBUF{basePos=NONE, info, ...} =>
358 :     inputExn (info, "filePosIn", IO.RandomAccessNotSupported)
359 :     | IBUF{basePos=SOME base, info, ...} => let
360 :     val INFO{reader=PIO.RD rd, readVec, ...} = info
361 :     in
362 :     case (#getPos rd, #setPos rd)
363 :     of (SOME getPos, SOME setPos) => let
364 :     val tmpPos = getPos()
365 :     fun readN 0 = ()
366 :     | readN n = (case V.length(readVec n)
367 :     of 0 => inputExn (
368 :     info, "filePosIn", Fail "bogus position")
369 :     | k => readN(n-k)
370 :     (* end case *))
371 :     in
372 :     setPos base;
373 :     readN pos;
374 :     getPos () before setPos tmpPos
375 :     end
376 :     | _ => raise Fail "filePosIn: impossible"
377 :     (* end case *)
378 :     end
379 :     (* end case *))
380 :    
381 :     (** Text stream specific operations **)
382 :     fun inputLine (ISTRM(buf as IBUF{data, more, ...}, pos)) = let
383 :     fun join (item, (list, strm)) = (item::list, strm)
384 :     fun nextBuf (buf as IBUF{more, data, ...}) = let
385 :     fun last () = (["\n"], ISTRM(buf, V.length data))
386 :     in
387 :     case !more
388 :     of (MORE buf) => scanData (buf, 0)
389 :     | (EOS buf) => last ()
390 :     | NOMORE => (
391 :     case extendStream (readVec buf, "inputLine", buf)
392 :     of (EOS _) => last ()
393 :     | (MORE rest) => scanData (rest, 0)
394 : monnier 498 | _ => raise Match (* shut up compiler *)
395 : monnier 416 (* end case *))
396 :     | TERMINATED => last ()
397 :     (* end case *)
398 :     end
399 :     and scanData (buf as IBUF{data, more, ...}, i) = let
400 :     val len = V.length data
401 :     fun scan j = if (j = len)
402 :     then join(vecExtract(data, i, NONE), nextBuf buf)
403 :     else if (vecSub(data, j) = #"\n")
404 :     then ([vecExtract(data, i, SOME(j+1-i))], ISTRM(buf, j+1))
405 :     else scan (j+1)
406 :     in
407 :     scan i
408 :     end
409 :     val (data, strm) = if (V.length data = pos)
410 :     then (case getBuffer (readVec buf, "inputLine") buf
411 :     of (EOS buf) => ([""], ISTRM(buf, 0))
412 :     | _ => nextBuf buf
413 :     (* end case *))
414 :     else scanData (buf, pos)
415 : mblume 1368 val res_v = V.concat data
416 : monnier 416 in
417 : mblume 1368 if V.length res_v = 0 then NONE else SOME (res_v, strm)
418 : monnier 416 end
419 :    
420 :     (*** Output streams ***)
421 :     datatype outstream = OSTRM of {
422 :     buf : A.array,
423 :     pos : int ref,
424 :     closed : bool ref,
425 :     bufferMode : IO.buffer_mode ref,
426 :     writer : writer,
427 : mblume 1381 writeArr : AS.slice -> unit,
428 :     writeVec : VS.slice -> unit,
429 : monnier 416 cleanTag : CleanIO.tag
430 :     }
431 :    
432 :     fun outputExn (OSTRM{writer=PIO.WR{name, ...}, ...}, mlOp, exn) =
433 :     raise IO.Io{function=mlOp, name=name, cause=exn}
434 :    
435 :     fun isNL #"\n" = true
436 :     | isNL _ = false
437 :    
438 :     fun isClosedOut (strm as OSTRM{closed=ref true, ...}, mlOp) =
439 :     outputExn (strm, mlOp, IO.ClosedStream)
440 :     | isClosedOut _ = ()
441 :    
442 :     fun flushBuffer (strm as OSTRM{buf, pos, writeArr, ...}, mlOp) = (
443 :     case !pos
444 :     of 0 => ()
445 : mblume 1381 | n => ((writeArr (AS.slice (buf, 0, SOME n)); pos := 0)
446 :     handle ex => outputExn (strm, mlOp, ex))
447 : monnier 416 (* end case *))
448 :    
449 :     (* A version of copyVec that checks for newlines, while it is copying.
450 :     * This is used for LINE_BUF output of strings and substrings.
451 :     *)
452 :     fun lineBufCopyVec (src, srcI, srcLen, dst, dstI) = let
453 :     val stop = srcI+srcLen
454 :     fun cpy (srcI, dstI, lb) =
455 :     if (srcI < stop)
456 :     then let val c = vecSub(src, srcI)
457 :     in
458 :     arrUpdate (dst, dstI, c);
459 :     cpy (srcI+1, dstI+1, lb orelse isNL c)
460 :     end
461 :     else lb
462 :     in
463 :     cpy (srcI, dstI, false)
464 :     end
465 :    
466 :     (* a version of copyVec for BLOCK_BUF output of strings and substrings. *)
467 : mblume 1350 fun blockBufCopyVec (src, srcI, srcLen, dst, dstI) =
468 :     (AS.copyVec { src = VS.slice (src, srcI, SOME srcLen),
469 :     dst = dst, di = dstI };
470 :     false)
471 : monnier 416
472 :     fun output (strm as OSTRM os, v) = let
473 :     val _ = isClosedOut (strm, "output")
474 :     val {buf, pos, bufferMode, ...} = os
475 :     fun flush () = flushBuffer (strm, "output")
476 :     fun writeDirect () = (
477 :     case !pos
478 :     of 0 => ()
479 : mblume 1381 | n => (#writeArr os (AS.slice (buf, 0, SOME n));
480 :     pos := 0)
481 : monnier 416 (* end case *);
482 : mblume 1381 #writeVec os (VS.full v))
483 : monnier 416 handle ex => outputExn (strm, "output", ex)
484 :     fun insert copyVec = let
485 :     val bufLen = A.length buf
486 :     val dataLen = V.length v
487 :     in
488 :     if (dataLen >= bufLen)
489 :     then writeDirect()
490 :     else let
491 :     val i = !pos
492 :     val avail = bufLen - i
493 :     in
494 :     if (avail < dataLen)
495 :     then let
496 : mblume 1350 val _ =
497 :     AS.copyVec { src=VS.slice(v,0,SOME avail),
498 :     dst=buf, di=i }
499 : mblume 1381 val _ = #writeArr os (AS.full buf)
500 : monnier 416 handle ex => (
501 :     pos := bufLen;
502 :     outputExn (strm, "output", ex))
503 :     val needsFlush = copyVec(v, avail, dataLen-avail, buf, 0)
504 :     in
505 :     pos := dataLen-avail;
506 :     if needsFlush then flush() else ()
507 :     end
508 :     else let
509 :     val needsFlush = copyVec(v, 0, dataLen, buf, i)
510 :     in
511 :     pos := i + dataLen;
512 :     if (needsFlush orelse (avail = dataLen))
513 :     then flush()
514 :     else ()
515 :     end
516 :     end
517 :     end
518 :     in
519 :     case !bufferMode
520 :     of IO.NO_BUF => writeDirect ()
521 :     | IO.LINE_BUF => insert lineBufCopyVec
522 :     | IO.BLOCK_BUF => insert blockBufCopyVec
523 :     (* end case *)
524 :     end
525 :    
526 :     fun output1 (strm as OSTRM{buf, pos, bufferMode, writeArr, ...}, elem) = (
527 :     isClosedOut (strm, "output1");
528 :     case !bufferMode
529 :     of IO.NO_BUF => (
530 :     arrUpdate (buf, 0, elem);
531 : mblume 1381 writeArr (AS.slice (buf, 0, SOME 1))
532 : monnier 416 handle ex => outputExn (strm, "output1", ex))
533 :     | IO.LINE_BUF => let val i = !pos val i' = i+1
534 :     in
535 :     arrUpdate (buf, i, elem); pos := i';
536 :     if ((i' = A.length buf) orelse (isNL elem))
537 :     then flushBuffer (strm, "output1")
538 :     else ()
539 :     end
540 :     | IO.BLOCK_BUF => let val i = !pos val i' = i+1
541 :     in
542 :     arrUpdate (buf, i, elem); pos := i';
543 :     if (i' = A.length buf)
544 :     then flushBuffer (strm, "output1")
545 :     else ()
546 :     end
547 :     (* end case *))
548 :    
549 :     fun flushOut strm = (
550 :     flushBuffer (strm, "flushOut"))
551 :    
552 :     fun closeOut (strm as OSTRM{writer=PIO.WR{close, ...}, closed, cleanTag, ...}) =
553 :     if !closed
554 :     then ()
555 :     else (
556 :     flushBuffer (strm, "closeOut");
557 :     closed := true;
558 :     CleanIO.removeCleaner cleanTag;
559 :     close())
560 :    
561 :     fun mkOutstream (wr as PIO.WR{chunkSize, writeArr, writeVec, ...}, mode) =
562 :     let
563 : mblume 1381 fun iterate (f, size, subslice) sl = let
564 :     fun lp sl =
565 :     if size sl = 0 then ()
566 :     else let val n = f sl
567 :     in
568 :     lp (subslice (sl, n, NONE))
569 :     end
570 :     in
571 :     lp sl
572 :     end
573 : monnier 416 val writeArr' = (case writeArr
574 :     of NONE => (fn _ => raise IO.BlockingNotSupported)
575 : mblume 1381 | (SOME f) => iterate (f, AS.length, AS.subslice)
576 : monnier 416 (* end case *))
577 :     val writeVec' = (case writeVec
578 :     of NONE => (fn _ => raise IO.BlockingNotSupported)
579 : mblume 1381 | (SOME f) => iterate (f, VS.length, VS.subslice)
580 : monnier 416 (* end case *))
581 :     (* install a dummy cleaner *)
582 :     val tag = CleanIO.addCleaner {
583 :     init = fn () => (),
584 :     flush = fn () => (),
585 :     close = fn () => ()
586 :     }
587 :     val strm = OSTRM{
588 :     buf = A.array(chunkSize, someElem),
589 :     pos = ref 0,
590 :     closed = ref false,
591 :     bufferMode = ref mode,
592 :     writer = wr,
593 :     writeArr = writeArr',
594 :     writeVec = writeVec',
595 :     cleanTag = tag
596 :     }
597 :     in
598 :     CleanIO.rebindCleaner (tag, {
599 :     init = fn () => closeOut strm,
600 :     flush = fn () => flushOut strm,
601 :     close = fn () => closeOut strm
602 :     });
603 :     strm
604 :     end
605 :    
606 :     fun getWriter (strm as OSTRM{writer, bufferMode, ...}) = (
607 :     flushBuffer (strm, "getWriter");
608 :     (writer, !bufferMode))
609 :    
610 :     (** Position operations on outstreams **)
611 :     datatype out_pos = OUTP of {
612 :     pos : PIO.pos,
613 :     strm : outstream
614 :     }
615 :    
616 :     fun getPosOut (strm as OSTRM{writer, ...}) = (
617 :     flushBuffer (strm, "getPosOut");
618 :     case writer
619 :     of PIO.WR{getPos=SOME f, ...} => (
620 :     OUTP{pos = f(), strm = strm}
621 :     handle ex => outputExn(strm, "getPosOut", ex))
622 :     | _ => outputExn(strm, "getPosOut", IO.RandomAccessNotSupported)
623 :     (* end case *))
624 :     fun filePosOut (OUTP{pos, strm}) = (
625 :     isClosedOut (strm, "filePosOut"); pos)
626 :     fun setPosOut (OUTP{pos, strm as OSTRM{writer, ...}}) = (
627 :     isClosedOut (strm, "setPosOut");
628 :     case writer
629 :     of PIO.WR{setPos=SOME f, ...} => (
630 :     (f pos)
631 :     handle ex => outputExn(strm, "setPosOut", ex))
632 :     | _ => outputExn(strm, "getPosOut", IO.RandomAccessNotSupported)
633 :     (* end case *))
634 :    
635 :     (** Text stream specific operations **)
636 :     fun outputSubstr (strm as OSTRM os, ss) = let
637 :     val _ = isClosedOut (strm, "outputSubstr")
638 :     val (v, dataStart, dataLen) = substringBase ss
639 :     val {buf, pos, bufferMode, ...} = os
640 :     val bufLen = A.length buf
641 :     fun flush () = flushBuffer (strm, "outputSubstr")
642 :     fun writeDirect () = (
643 :     case !pos
644 :     of 0 => ()
645 : mblume 1381 | n => (#writeArr os (AS.slice (buf, 0, SOME n));
646 :     pos := 0)
647 : monnier 416 (* end case *);
648 : mblume 1381 #writeVec os (VS.slice (v, dataStart, SOME dataLen)))
649 :     handle ex => outputExn (strm, "outputSubstr", ex)
650 : monnier 416 fun insert copyVec = let
651 :     val bufLen = A.length buf
652 :     in
653 :     if (dataLen >= bufLen)
654 :     then writeDirect()
655 :     else let
656 :     val i = !pos
657 :     val avail = bufLen - i
658 :     in
659 :     if (avail < dataLen)
660 :     then let
661 : mblume 1350 val _ =
662 :     AS.copyVec { src = VS.slice
663 :     (v,dataStart,SOME avail),
664 :     dst = buf, di = i }
665 : mblume 1381 val _ = #writeArr os (AS.full buf)
666 : monnier 416 handle ex => (
667 :     pos := bufLen;
668 :     outputExn (strm, "outputSubstr", ex))
669 : blume 1189 val needsFlush =
670 :     copyVec(v, dataStart+avail, dataLen-avail, buf, 0)
671 : monnier 416 in
672 :     pos := dataLen-avail;
673 :     if needsFlush then flush() else ()
674 :     end
675 :     else let
676 :     val needsFlush = copyVec(v, dataStart, dataLen, buf, i)
677 :     in
678 :     pos := i + dataLen;
679 :     if (needsFlush orelse (avail = dataLen))
680 :     then flush()
681 :     else ()
682 :     end
683 :     end
684 :     end
685 :     in
686 :     case !bufferMode
687 :     of IO.NO_BUF => writeDirect()
688 :     | IO.LINE_BUF => insert lineBufCopyVec
689 :     | IO.BLOCK_BUF => insert blockBufCopyVec
690 :     (* end case *)
691 :     end
692 :    
693 :     fun setBufferMode (strm as OSTRM{bufferMode, ...}, IO.NO_BUF) = (
694 :     flushBuffer (strm, "setBufferMode");
695 :     bufferMode := IO.NO_BUF)
696 :     | setBufferMode (strm as OSTRM{bufferMode, ...}, mode) = (
697 :     isClosedOut (strm, "setBufferMode");
698 :     bufferMode := mode)
699 :     fun getBufferMode (strm as OSTRM{bufferMode, ...}) = (
700 :     isClosedOut (strm, "getBufferMode");
701 :     !bufferMode)
702 :    
703 :     end (* StreamIO *)
704 :    
705 :     type vector = V.vector
706 :     type elem = V.elem
707 :     type instream = StreamIO.instream ref
708 :     type outstream = StreamIO.outstream ref
709 :    
710 :     (** Input operations **)
711 :     fun input strm = let val (v, strm') = StreamIO.input(!strm)
712 :     in
713 :     strm := strm'; v
714 :     end
715 :     fun input1 strm = (case StreamIO.input1(!strm)
716 :     of NONE => NONE
717 :     | (SOME(elem, strm')) => (strm := strm'; SOME elem)
718 :     (* end case *))
719 :     fun inputN (strm, n) = let val (v, strm') = StreamIO.inputN (!strm, n)
720 :     in
721 :     strm := strm'; v
722 :     end
723 :     fun inputAll (strm : instream) = let
724 :     val (v, s) = StreamIO.inputAll(!strm)
725 :     in
726 :     strm := s; v
727 :     end
728 :     fun canInput (strm, n) = StreamIO.canInput (!strm, n)
729 :     fun lookahead (strm : instream) = (case StreamIO.input1(!strm)
730 :     of NONE => NONE
731 :     | (SOME(elem, _)) => SOME elem
732 :     (* end case *))
733 :     fun closeIn strm = let
734 :     val (s as StreamIO.ISTRM(buf as StreamIO.IBUF{data, ...}, _)) = !strm
735 :     (* find the end of the stream *)
736 :     fun findEOS (StreamIO.IBUF{more=ref(StreamIO.MORE buf), ...}) =
737 :     findEOS buf
738 :     | findEOS (StreamIO.IBUF{more=ref(StreamIO.EOS buf), ...}) =
739 :     findEOS buf
740 :     | findEOS (buf as StreamIO.IBUF{data, ...}) =
741 :     StreamIO.ISTRM(buf, V.length data)
742 :     in
743 :     StreamIO.closeIn s;
744 :     strm := findEOS buf
745 :     end
746 :     fun endOfStream strm = StreamIO.endOfStream(! strm)
747 :    
748 :     (** Output operations **)
749 :     fun output (strm, v) = StreamIO.output(!strm, v)
750 :     fun output1 (strm, c) = StreamIO.output1(!strm, c)
751 :     fun flushOut strm = StreamIO.flushOut(!strm)
752 :     fun closeOut strm = StreamIO.closeOut(!strm)
753 :     fun getPosOut strm = StreamIO.getPosOut(!strm)
754 :     fun setPosOut (strm, p as StreamIO.OUTP{strm=strm', ...}) = (
755 :     strm := strm'; StreamIO.setPosOut p)
756 :    
757 :     fun mkInstream (strm : StreamIO.instream) = ref strm
758 :     fun getInstream (strm : instream) = !strm
759 :     fun setInstream (strm : instream, strm') = strm := strm'
760 :    
761 :     fun mkOutstream (strm : StreamIO.outstream) = ref strm
762 :     fun getOutstream (strm : outstream) = !strm
763 :     fun setOutstream (strm : outstream, strm') = strm := strm'
764 :    
765 :     (* figure out the proper buffering mode for a given writer *)
766 :     fun bufferMode (PIO.WR{ioDesc=NONE, ...}) = IO.BLOCK_BUF
767 :     | bufferMode (PIO.WR{ioDesc=SOME iod, ...}) =
768 :     if (OS.IO.kind iod = OS.IO.Kind.tty) then IO.LINE_BUF else IO.BLOCK_BUF
769 :    
770 :     (** Open files **)
771 :     fun openIn fname =
772 : jhr 2849 mkInstream(StreamIO.mkInstream(PIO.openRd fname, empty))
773 : monnier 416 handle ex => raise IO.Io{function="openIn", name=fname, cause=ex}
774 :     fun openOut fname = let
775 : jhr 2849 val wr = PIO.openWr fname
776 : monnier 416 in
777 :     mkOutstream (StreamIO.mkOutstream (wr, bufferMode wr))
778 :     end
779 :     handle ex => raise IO.Io{function="openOut", name=fname, cause=ex}
780 :     fun openAppend fname =
781 : jhr 2849 mkOutstream(StreamIO.mkOutstream(PIO.openApp fname, IO.NO_BUF))
782 : monnier 416 handle ex => raise IO.Io{function="openAppend", name=fname, cause=ex}
783 :    
784 :     (** Text stream specific operations **)
785 : mblume 1368 fun inputLine strm =
786 :     Option.map (fn (v, s) => (strm := s; v)) (StreamIO.inputLine (!strm))
787 : monnier 416 fun outputSubstr (strm, ss) = StreamIO.outputSubstr (!strm, ss)
788 :     fun openString src =
789 : jhr 2849 mkInstream(StreamIO.mkInstream(PIO.strReader src, empty))
790 : monnier 416 handle ex => raise IO.Io{function="openIn", name="<string>", cause=ex}
791 :    
792 :     (* the standard streams *)
793 :     local
794 :     structure SIO = StreamIO
795 :     fun mkStdIn () = let
796 :     val (strm as SIO.ISTRM(SIO.IBUF{info=SIO.INFO{cleanTag, ...}, ...}, _)) =
797 : jhr 2849 SIO.mkInstream(PIO.stdIn(), empty)
798 : monnier 416 in
799 :     CleanIO.rebindCleaner (cleanTag, {
800 :     init = fn () => (),
801 :     flush = fn () => (),
802 :     close = fn () => ()
803 :     });
804 :     strm
805 :     end
806 :     fun mkStdOut () = let
807 : jhr 2849 val wr = PIO.stdOut()
808 : monnier 416 val (strm as SIO.OSTRM{cleanTag, ...}) =
809 :     SIO.mkOutstream(wr, bufferMode wr)
810 :     in
811 :     CleanIO.rebindCleaner (cleanTag, {
812 :     init = fn () => (),
813 :     flush = fn () => SIO.flushOut strm,
814 :     close = fn () => SIO.flushOut strm
815 :     });
816 :     strm
817 :     end
818 :     fun mkStdErr () = let
819 :     val (strm as SIO.OSTRM{cleanTag, ...}) =
820 : jhr 2849 SIO.mkOutstream(PIO.stdErr(), IO.NO_BUF)
821 : monnier 416 in
822 :     CleanIO.rebindCleaner (cleanTag, {
823 :     init = fn () => (),
824 :     flush = fn () => SIO.flushOut strm,
825 :     close = fn () => SIO.flushOut strm
826 :     });
827 :     strm
828 :     end
829 :     in
830 :     val stdIn = mkInstream(mkStdIn())
831 :     val stdOut = mkOutstream(mkStdOut())
832 :     val stdErr = mkOutstream(mkStdErr())
833 :    
834 :     (* Establish a hook function to rebuild the I/O stack *)
835 :     val _ = CleanIO.stdStrmHook := (fn () => (
836 :     setInstream (stdIn, mkStdIn());
837 :     setOutstream (stdOut, mkStdOut());
838 :     setOutstream (stdErr, mkStdErr())))
839 :     end (* local *)
840 :    
841 :     fun print s = (output (stdOut, s); flushOut stdOut)
842 :    
843 :     fun scanStream scanFn = let
844 :     val scan = scanFn StreamIO.input1
845 :     fun doit strm = let
846 :     val instrm = getInstream strm
847 :     in
848 :     case scan instrm
849 :     of NONE => NONE
850 :     | SOME(item, instrm') => (
851 :     setInstream(strm, instrm');
852 :     SOME item)
853 :     (* end case *)
854 :     end
855 :     in
856 :     doit
857 :     end
858 :    
859 : jhr 2849 end (* TextIO *)
860 : monnier 416 end
861 :    

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