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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1381 - (view) (download)

1 : monnier 416 (* text-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 OS = OSImp
13 :     in
14 :     functor TextIOFn (
15 :    
16 :     structure OSPrimIO : sig
17 :     include OS_PRIM_IO
18 :     val stdIn : unit -> PrimIO.reader
19 :     val stdOut : unit -> PrimIO.writer
20 :     val stdErr : unit -> PrimIO.writer
21 :     val strReader : string -> PrimIO.reader
22 :     end
23 :     where PrimIO = TextPrimIO
24 :    
25 :     ) : TEXT_IO = struct
26 :    
27 :     structure PIO = OSPrimIO.PrimIO
28 :     structure A = CharArray
29 :     structure V = CharVector
30 : mblume 1350 structure AS = CharArraySlice
31 :     structure VS = CharVectorSlice
32 : monnier 416
33 :     (* an element for initializing buffers *)
34 :     val someElem = #"\000"
35 :    
36 :     (** Fast, but unsafe version (from CharVector) **
37 :     val vecSub = InlineT.CharVector.sub
38 :     val arrUpdate = InlineT.CharArray.update
39 :     (* fast vector extract operation. This should never be called with
40 :     * a length of 0.
41 :     *)
42 :     fun vecExtract (v, base, optLen) = let
43 :     val len = V.length v
44 :     fun newVec n = let
45 :     val newV = Assembly.A.create_s n
46 :     fun fill i = if (i < n)
47 :     then (
48 :     InlineT.CharVector.update(newV, i, vecSub(v, base+i));
49 :     fill(i+1))
50 :     else ()
51 :     in
52 :     fill 0; newV
53 :     end
54 :     in
55 :     case (base, optLen)
56 :     of (0, NONE) => v
57 :     | (_, NONE) => newVec (len - base)
58 :     | (_, SOME n) => newVec n
59 :     (* end case *)
60 :     end
61 :     **)
62 : mblume 1350 val vecExtract = VS.vector o VS.slice
63 : monnier 416 val vecSub = V.sub
64 :     val arrUpdate = A.update
65 :     val substringBase = Substring.base
66 :     val empty = ""
67 :    
68 :     structure StreamIO =
69 :     struct
70 :     type vector = V.vector
71 :     type elem = V.elem
72 :     type reader = PIO.reader
73 :     type writer = PIO.writer
74 :     type pos = PIO.pos
75 :    
76 :     (*** Functional input streams ***
77 :     ** We represent an instream by a pointer to a buffer and an offset
78 :     ** into the buffer. The buffers are chained by the "more" field from
79 :     ** the beginning of the stream towards the end. If the "more" field
80 :     ** is EOS, then it refers to an empty buffer (consuming the EOF marker
81 :     ** involves moving the stream from immeditaly in front of the EOS to
82 :     ** to the empty buffer). A "more" field of TERMINATED marks a
83 :     ** terminated stream. We also have the invariant that the "tail"
84 :     ** field of the "info" structure points to a more ref that is either
85 :     ** NOMORE or TERMINATED.
86 :     **)
87 :     datatype instream = ISTRM of (in_buffer * int)
88 :     and in_buffer = IBUF of {
89 :     basePos : pos option,
90 :     more : more ref,
91 :     data : vector,
92 :     info : info
93 :     }
94 :     and more
95 :     = MORE of in_buffer (* forward link to additional data *)
96 :     | EOS of in_buffer (* End of stream marker *)
97 :     | NOMORE (* placeholder for forward link *)
98 :     | TERMINATED (* termination of the stream *)
99 :    
100 :     and info = INFO of {
101 :     reader : reader,
102 :     readVec : int -> vector,
103 :     readVecNB : (int -> vector) option,
104 :     closed : bool ref,
105 :     getPos : unit -> pos option,
106 :     tail : more ref ref, (* points to the more cell of the last buffer *)
107 :     cleanTag : CleanIO.tag
108 :     }
109 :    
110 :     fun infoOfIBuf (IBUF{info, ...}) = info
111 :     fun chunkSzOfIBuf buf = let
112 :     val INFO{reader=PIO.RD{chunkSize, ...}, ...} = infoOfIBuf buf
113 :     in
114 :     chunkSize
115 :     end
116 :     fun readVec (IBUF{info=INFO{readVec=f, ...}, ...}) = f
117 :    
118 :     fun inputExn (INFO{reader=PIO.RD{name, ...}, ...}, mlOp, exn) =
119 :     raise IO.Io{function=mlOp, name=name, cause=exn}
120 :    
121 :     (* this exception is raised by readVecNB in the blocking case *)
122 :     exception WouldBlock
123 :    
124 :     fun extendStream (readFn, mlOp, buf as IBUF{more, info, ...}) = (let
125 :     val INFO{getPos, tail, ...} = info
126 :     val basePos = getPos()
127 :     val chunk = readFn (chunkSzOfIBuf buf)
128 :     val newMore = ref NOMORE
129 :     val buf' = IBUF{
130 :     basePos = basePos, data = chunk,
131 :     more = newMore, info = info
132 :     }
133 :     val next = if (V.length chunk = 0) then EOS buf' else MORE buf'
134 :     in
135 :     more := next;
136 :     tail := newMore;
137 :     next
138 :     end
139 :     handle ex => inputExn(info, mlOp, ex))
140 :    
141 :     fun getBuffer (readFn, mlOp) (buf as IBUF{more, info, ...}) = (
142 :     case !more
143 :     of TERMINATED => (EOS buf)
144 :     | NOMORE => extendStream (readFn, mlOp, buf)
145 :     | more => more
146 :     (* end case *))
147 :    
148 :     (* read a chunk that is at least the specified size *)
149 :     fun readChunk buf = let
150 :     val INFO{readVec, reader=PIO.RD{chunkSize, ...}, ...} =
151 :     infoOfIBuf buf
152 :     in
153 :     case (chunkSize - 1)
154 :     of 0 => (fn n => readVec n)
155 :     | k => (* round up to next multiple of chunkSize *)
156 :     (fn n => readVec(Int.quot((n+k), chunkSize) * chunkSize))
157 :     (* end case *)
158 :     end
159 :    
160 :     fun generalizedInput getBuf = let
161 :     fun get (ISTRM(buf as IBUF{data, ...}, pos)) = let
162 :     val len = V.length data
163 :     in
164 :     if (pos < len)
165 :     then (vecExtract(data, pos, NONE), ISTRM(buf, len))
166 :     else (case (getBuf buf)
167 :     of (EOS buf) => (empty, ISTRM(buf, 0))
168 :     | (MORE rest) => get (ISTRM(rest, 0))
169 :     | _ => raise Fail "bogus getBuf"
170 :     (* end case *))
171 :     end
172 :     in
173 :     get
174 :     end
175 :    
176 :    
177 :     (* terminate an input stream *)
178 :     fun terminate (INFO{tail, cleanTag, ...}) = (case !tail
179 :     of (m as ref NOMORE) => (
180 :     CleanIO.removeCleaner cleanTag;
181 :     m := TERMINATED)
182 :     | (m as ref TERMINATED) => ()
183 : monnier 498 | _ => raise Match (* shut up compiler *)
184 : monnier 416 (* end case *))
185 :    
186 :     fun input (strm as ISTRM(buf, _)) =
187 :     generalizedInput (getBuffer (readVec buf, "input")) strm
188 :     fun input1 (ISTRM(buf, pos)) = let
189 :     val IBUF{data, more, ...} = buf
190 :     in
191 :     if (pos < V.length data)
192 :     then SOME(vecSub(data, pos), ISTRM(buf, pos+1))
193 :     else (case !more
194 :     of (MORE buf) => input1 (ISTRM(buf, 0))
195 :     | (EOS _) => NONE
196 :     | NOMORE => (
197 :     case extendStream (readVec buf, "input1", buf)
198 :     of (MORE rest) => input1 (ISTRM(rest, 0))
199 :     | _ => NONE
200 :     (* end case *))
201 :     | TERMINATED => NONE
202 :     (* end case *))
203 :     end
204 :     fun inputN (ISTRM(buf, pos), n) = let
205 :     fun join (item, (list, strm)) = (item::list, strm)
206 :     fun inputList (buf as IBUF{data, ...}, i, n) = let
207 :     val len = V.length data
208 :     val remain = len-i
209 :     in
210 :     if (remain >= n)
211 :     then ([vecExtract(data, i, SOME n)], ISTRM(buf, i+n))
212 :     else join (
213 :     vecExtract(data, i, NONE),
214 :     nextBuf(buf, n-remain))
215 :     end
216 :     and nextBuf (buf as IBUF{more, data, ...}, n) = (case !more
217 :     of (MORE buf) => inputList (buf, 0, n)
218 :     | (EOS buf) => ([], ISTRM(buf, 0))
219 :     | NOMORE => (
220 :     case extendStream (readVec buf, "inputN", buf)
221 :     of (MORE rest) => inputList (rest, 0, n)
222 :     | _ => ([], ISTRM(buf, V.length data))
223 :     (* end case *))
224 :     | TERMINATED => ([], ISTRM(buf, V.length data))
225 :     (* end case *))
226 :     val (data, strm) = inputList (buf, pos, n)
227 :     in
228 :     (V.concat data, strm)
229 :     end
230 :     fun inputAll (strm as ISTRM(buf, _)) = let
231 :     val INFO{reader=PIO.RD{avail, ...}, ...} = infoOfIBuf buf
232 :     (* Read a chunk that is as large as the available input. Note
233 :     * that for systems that use CR-LF for #"\n", the size will be
234 :     * too large, but this should be okay.
235 :     *)
236 :     fun bigChunk _ = let
237 :     val delta = (case avail()
238 :     of NONE => chunkSzOfIBuf buf
239 :     | (SOME n) => n
240 :     (* end case *))
241 :     in
242 :     readChunk buf delta
243 :     end
244 :     val bigInput =
245 :     generalizedInput (getBuffer (bigChunk, "inputAll"))
246 :     fun loop (v, strm) = if (V.length v = 0)
247 :     then ([], strm)
248 :     else let val (l, strm') = loop(bigInput strm)
249 :     in
250 :     (v :: l, strm')
251 :     end
252 :     val (data, strm') = loop (bigInput strm)
253 :     in
254 :     (V.concat data, strm')
255 :     end
256 :     (* Return SOME k, if k <= amount characters can be read without blocking. *)
257 :     fun canInput (strm as ISTRM(buf, pos), amount) = let
258 :     val readVecNB = (case buf
259 :     of (IBUF{info as INFO{readVecNB=NONE, ...}, ...}) =>
260 :     inputExn(info, "canInput", IO.NonblockingNotSupported)
261 :     | (IBUF{info=INFO{readVecNB=SOME f, ...}, ...}) => f
262 :     (* end case *))
263 :     fun tryInput (buf as IBUF{data, ...}, i, n) = let
264 :     val len = V.length data
265 :     val remain = len - i
266 :     in
267 :     if (remain >= n)
268 :     then SOME n
269 :     else nextBuf (buf, n - remain)
270 :     end
271 :     and nextBuf (IBUF{more, ...}, n) = (case !more
272 :     of (MORE buf) => tryInput (buf, 0, n)
273 :     | (EOS _) => SOME(amount - n)
274 :     | TERMINATED => SOME(amount - n)
275 :     | NOMORE => ((
276 :     case extendStream (readVecNB, "canInput", buf)
277 :     of (MORE b) => tryInput (b, 0, n)
278 :     | _ => SOME(amount - n)
279 :     (* end case *))
280 :     handle IO.Io{cause=WouldBlock, ...} => SOME(amount - n))
281 :     (* end case *))
282 :     in
283 :     if (amount < 0)
284 :     then raise Size
285 :     else tryInput (buf, pos, amount)
286 :     end
287 :     fun closeIn (ISTRM(buf, _)) = (case (infoOfIBuf buf)
288 :     of INFO{closed=ref true, ...} => ()
289 :     | (info as INFO{closed, reader=PIO.RD{close, ...}, ...}) => (
290 :     terminate info;
291 :     closed := true;
292 :     close() handle ex => inputExn(info, "closeIn", ex))
293 :     (* end case *))
294 :     fun endOfStream (ISTRM(buf, pos)) = (case buf
295 :     of (IBUF{more=ref(MORE _), ...}) => false
296 :     | (IBUF{more=ref(EOS _), ...}) => true
297 :     | (IBUF{more, data, info=INFO{closed, ...}, ...}) =>
298 :     if (pos = V.length data)
299 :     then (case (!more, !closed)
300 :     of (NOMORE, false) => (
301 :     case extendStream (readVec buf, "endOfStream", buf)
302 :     of (EOS _) => true
303 :     | _ => false
304 :     (* end case *))
305 :     | _ => true
306 :     (* end case *))
307 :     else false
308 :     (* end case *))
309 :     fun mkInstream (reader, data) = let
310 :     val PIO.RD{readVec, readVecNB, getPos, setPos, ...} = reader
311 :     val readVec' = (case readVec
312 :     of NONE => (fn _ => raise IO.BlockingNotSupported)
313 :     | (SOME f) => f
314 :     (* end case *))
315 :     val readVecNB' = (case readVecNB
316 :     of NONE => NONE
317 :     | (SOME f) => SOME(fn arg => case (f arg)
318 :     of (SOME x) => x
319 :     | NONE => raise WouldBlock
320 :     (* end case *))
321 :     (* end case *))
322 :     val getPos = (case (getPos, setPos)
323 :     of (SOME f, SOME _) => (fn () => SOME(f()))
324 :     | _ => (fn () => NONE)
325 :     (* end case *))
326 :     val more = ref NOMORE
327 :     val closedFlg = ref false
328 :     val tag = CleanIO.addCleaner {
329 :     init = fn () => (closedFlg := true),
330 :     flush = fn () => (),
331 :     close = fn () => (closedFlg := true)
332 :     }
333 :     val info = INFO{
334 :     reader=reader, readVec=readVec', readVecNB=readVecNB',
335 :     closed = closedFlg, getPos = getPos, tail = ref more,
336 :     cleanTag = tag
337 :     }
338 :     (** What should we do about the position when there is initial data?? **)
339 :     (** Suggestion: When building a stream with supplied initial data,
340 :     ** nothing can be said about the positions inside that initial
341 :     ** data (who knows where that data even came from!).
342 :     **)
343 :     val basePos = if (V.length data = 0)
344 :     then getPos()
345 :     else NONE
346 :     in
347 :     ISTRM(
348 :     IBUF{basePos = basePos, data = data, info = info, more = more},
349 :     0)
350 :     end
351 :    
352 :     fun getReader (ISTRM(buf, pos)) = let
353 :     val IBUF{data, info as INFO{reader, ...}, more, ...} = buf
354 :     fun getData (MORE(IBUF{data, more, ...})) = data :: getData(!more)
355 :     | getData _ = []
356 :     in
357 :     terminate info;
358 :     if (pos < V.length data)
359 :     then (
360 :     reader,
361 :     V.concat(vecExtract(data, pos, NONE) :: getData(!more))
362 :     )
363 :     else (reader, V.concat(getData(!more)))
364 :     end
365 :    
366 :     (* Get the underlying file position of a stream *)
367 :     fun filePosIn (ISTRM(buf, pos)) = (case buf
368 :     of IBUF{basePos=NONE, info, ...} =>
369 :     inputExn (info, "filePosIn", IO.RandomAccessNotSupported)
370 :     | IBUF{basePos=SOME base, info, ...} => let
371 :     val INFO{reader=PIO.RD rd, readVec, ...} = info
372 :     in
373 :     case (#getPos rd, #setPos rd)
374 :     of (SOME getPos, SOME setPos) => let
375 :     val tmpPos = getPos()
376 :     fun readN 0 = ()
377 :     | readN n = (case V.length(readVec n)
378 :     of 0 => inputExn (
379 :     info, "filePosIn", Fail "bogus position")
380 :     | k => readN(n-k)
381 :     (* end case *))
382 :     in
383 :     setPos base;
384 :     readN pos;
385 :     getPos () before setPos tmpPos
386 :     end
387 :     | _ => raise Fail "filePosIn: impossible"
388 :     (* end case *)
389 :     end
390 :     (* end case *))
391 :    
392 :     (** Text stream specific operations **)
393 :     fun inputLine (ISTRM(buf as IBUF{data, more, ...}, pos)) = let
394 :     fun join (item, (list, strm)) = (item::list, strm)
395 :     fun nextBuf (buf as IBUF{more, data, ...}) = let
396 :     fun last () = (["\n"], ISTRM(buf, V.length data))
397 :     in
398 :     case !more
399 :     of (MORE buf) => scanData (buf, 0)
400 :     | (EOS buf) => last ()
401 :     | NOMORE => (
402 :     case extendStream (readVec buf, "inputLine", buf)
403 :     of (EOS _) => last ()
404 :     | (MORE rest) => scanData (rest, 0)
405 : monnier 498 | _ => raise Match (* shut up compiler *)
406 : monnier 416 (* end case *))
407 :     | TERMINATED => last ()
408 :     (* end case *)
409 :     end
410 :     and scanData (buf as IBUF{data, more, ...}, i) = let
411 :     val len = V.length data
412 :     fun scan j = if (j = len)
413 :     then join(vecExtract(data, i, NONE), nextBuf buf)
414 :     else if (vecSub(data, j) = #"\n")
415 :     then ([vecExtract(data, i, SOME(j+1-i))], ISTRM(buf, j+1))
416 :     else scan (j+1)
417 :     in
418 :     scan i
419 :     end
420 :     val (data, strm) = if (V.length data = pos)
421 :     then (case getBuffer (readVec buf, "inputLine") buf
422 :     of (EOS buf) => ([""], ISTRM(buf, 0))
423 :     | _ => nextBuf buf
424 :     (* end case *))
425 :     else scanData (buf, pos)
426 : mblume 1368 val res_v = V.concat data
427 : monnier 416 in
428 : mblume 1368 if V.length res_v = 0 then NONE else SOME (res_v, strm)
429 : monnier 416 end
430 :    
431 :     (*** Output streams ***)
432 :     datatype outstream = OSTRM of {
433 :     buf : A.array,
434 :     pos : int ref,
435 :     closed : bool ref,
436 :     bufferMode : IO.buffer_mode ref,
437 :     writer : writer,
438 : mblume 1381 writeArr : AS.slice -> unit,
439 :     writeVec : VS.slice -> unit,
440 : monnier 416 cleanTag : CleanIO.tag
441 :     }
442 :    
443 :     fun outputExn (OSTRM{writer=PIO.WR{name, ...}, ...}, mlOp, exn) =
444 :     raise IO.Io{function=mlOp, name=name, cause=exn}
445 :    
446 :     fun isNL #"\n" = true
447 :     | isNL _ = false
448 :    
449 :     fun isClosedOut (strm as OSTRM{closed=ref true, ...}, mlOp) =
450 :     outputExn (strm, mlOp, IO.ClosedStream)
451 :     | isClosedOut _ = ()
452 :    
453 :     fun flushBuffer (strm as OSTRM{buf, pos, writeArr, ...}, mlOp) = (
454 :     case !pos
455 :     of 0 => ()
456 : mblume 1381 | n => ((writeArr (AS.slice (buf, 0, SOME n)); pos := 0)
457 :     handle ex => outputExn (strm, mlOp, ex))
458 : monnier 416 (* end case *))
459 :    
460 :     (* A version of copyVec that checks for newlines, while it is copying.
461 :     * This is used for LINE_BUF output of strings and substrings.
462 :     *)
463 :     fun lineBufCopyVec (src, srcI, srcLen, dst, dstI) = let
464 :     val stop = srcI+srcLen
465 :     fun cpy (srcI, dstI, lb) =
466 :     if (srcI < stop)
467 :     then let val c = vecSub(src, srcI)
468 :     in
469 :     arrUpdate (dst, dstI, c);
470 :     cpy (srcI+1, dstI+1, lb orelse isNL c)
471 :     end
472 :     else lb
473 :     in
474 :     cpy (srcI, dstI, false)
475 :     end
476 :    
477 :     (* a version of copyVec for BLOCK_BUF output of strings and substrings. *)
478 : mblume 1350 fun blockBufCopyVec (src, srcI, srcLen, dst, dstI) =
479 :     (AS.copyVec { src = VS.slice (src, srcI, SOME srcLen),
480 :     dst = dst, di = dstI };
481 :     false)
482 : monnier 416
483 :     fun output (strm as OSTRM os, v) = let
484 :     val _ = isClosedOut (strm, "output")
485 :     val {buf, pos, bufferMode, ...} = os
486 :     fun flush () = flushBuffer (strm, "output")
487 :     fun writeDirect () = (
488 :     case !pos
489 :     of 0 => ()
490 : mblume 1381 | n => (#writeArr os (AS.slice (buf, 0, SOME n));
491 :     pos := 0)
492 : monnier 416 (* end case *);
493 : mblume 1381 #writeVec os (VS.full v))
494 : monnier 416 handle ex => outputExn (strm, "output", ex)
495 :     fun insert copyVec = let
496 :     val bufLen = A.length buf
497 :     val dataLen = V.length v
498 :     in
499 :     if (dataLen >= bufLen)
500 :     then writeDirect()
501 :     else let
502 :     val i = !pos
503 :     val avail = bufLen - i
504 :     in
505 :     if (avail < dataLen)
506 :     then let
507 : mblume 1350 val _ =
508 :     AS.copyVec { src=VS.slice(v,0,SOME avail),
509 :     dst=buf, di=i }
510 : mblume 1381 val _ = #writeArr os (AS.full buf)
511 : monnier 416 handle ex => (
512 :     pos := bufLen;
513 :     outputExn (strm, "output", ex))
514 :     val needsFlush = copyVec(v, avail, dataLen-avail, buf, 0)
515 :     in
516 :     pos := dataLen-avail;
517 :     if needsFlush then flush() else ()
518 :     end
519 :     else let
520 :     val needsFlush = copyVec(v, 0, dataLen, buf, i)
521 :     in
522 :     pos := i + dataLen;
523 :     if (needsFlush orelse (avail = dataLen))
524 :     then flush()
525 :     else ()
526 :     end
527 :     end
528 :     end
529 :     in
530 :     case !bufferMode
531 :     of IO.NO_BUF => writeDirect ()
532 :     | IO.LINE_BUF => insert lineBufCopyVec
533 :     | IO.BLOCK_BUF => insert blockBufCopyVec
534 :     (* end case *)
535 :     end
536 :    
537 :     fun output1 (strm as OSTRM{buf, pos, bufferMode, writeArr, ...}, elem) = (
538 :     isClosedOut (strm, "output1");
539 :     case !bufferMode
540 :     of IO.NO_BUF => (
541 :     arrUpdate (buf, 0, elem);
542 : mblume 1381 writeArr (AS.slice (buf, 0, SOME 1))
543 : monnier 416 handle ex => outputExn (strm, "output1", ex))
544 :     | IO.LINE_BUF => let val i = !pos val i' = i+1
545 :     in
546 :     arrUpdate (buf, i, elem); pos := i';
547 :     if ((i' = A.length buf) orelse (isNL elem))
548 :     then flushBuffer (strm, "output1")
549 :     else ()
550 :     end
551 :     | IO.BLOCK_BUF => let val i = !pos val i' = i+1
552 :     in
553 :     arrUpdate (buf, i, elem); pos := i';
554 :     if (i' = A.length buf)
555 :     then flushBuffer (strm, "output1")
556 :     else ()
557 :     end
558 :     (* end case *))
559 :    
560 :     fun flushOut strm = (
561 :     flushBuffer (strm, "flushOut"))
562 :    
563 :     fun closeOut (strm as OSTRM{writer=PIO.WR{close, ...}, closed, cleanTag, ...}) =
564 :     if !closed
565 :     then ()
566 :     else (
567 :     flushBuffer (strm, "closeOut");
568 :     closed := true;
569 :     CleanIO.removeCleaner cleanTag;
570 :     close())
571 :    
572 :     fun mkOutstream (wr as PIO.WR{chunkSize, writeArr, writeVec, ...}, mode) =
573 :     let
574 : mblume 1381 fun iterate (f, size, subslice) sl = let
575 :     fun lp sl =
576 :     if size sl = 0 then ()
577 :     else let val n = f sl
578 :     in
579 :     lp (subslice (sl, n, NONE))
580 :     end
581 :     in
582 :     lp sl
583 :     end
584 : monnier 416 val writeArr' = (case writeArr
585 :     of NONE => (fn _ => raise IO.BlockingNotSupported)
586 : mblume 1381 | (SOME f) => iterate (f, AS.length, AS.subslice)
587 : monnier 416 (* end case *))
588 :     val writeVec' = (case writeVec
589 :     of NONE => (fn _ => raise IO.BlockingNotSupported)
590 : mblume 1381 | (SOME f) => iterate (f, VS.length, VS.subslice)
591 : monnier 416 (* end case *))
592 :     (* install a dummy cleaner *)
593 :     val tag = CleanIO.addCleaner {
594 :     init = fn () => (),
595 :     flush = fn () => (),
596 :     close = fn () => ()
597 :     }
598 :     val strm = OSTRM{
599 :     buf = A.array(chunkSize, someElem),
600 :     pos = ref 0,
601 :     closed = ref false,
602 :     bufferMode = ref mode,
603 :     writer = wr,
604 :     writeArr = writeArr',
605 :     writeVec = writeVec',
606 :     cleanTag = tag
607 :     }
608 :     in
609 :     CleanIO.rebindCleaner (tag, {
610 :     init = fn () => closeOut strm,
611 :     flush = fn () => flushOut strm,
612 :     close = fn () => closeOut strm
613 :     });
614 :     strm
615 :     end
616 :    
617 :     fun getWriter (strm as OSTRM{writer, bufferMode, ...}) = (
618 :     flushBuffer (strm, "getWriter");
619 :     (writer, !bufferMode))
620 :    
621 :     (** Position operations on outstreams **)
622 :     datatype out_pos = OUTP of {
623 :     pos : PIO.pos,
624 :     strm : outstream
625 :     }
626 :    
627 :     fun getPosOut (strm as OSTRM{writer, ...}) = (
628 :     flushBuffer (strm, "getPosOut");
629 :     case writer
630 :     of PIO.WR{getPos=SOME f, ...} => (
631 :     OUTP{pos = f(), strm = strm}
632 :     handle ex => outputExn(strm, "getPosOut", ex))
633 :     | _ => outputExn(strm, "getPosOut", IO.RandomAccessNotSupported)
634 :     (* end case *))
635 :     fun filePosOut (OUTP{pos, strm}) = (
636 :     isClosedOut (strm, "filePosOut"); pos)
637 :     fun setPosOut (OUTP{pos, strm as OSTRM{writer, ...}}) = (
638 :     isClosedOut (strm, "setPosOut");
639 :     case writer
640 :     of PIO.WR{setPos=SOME f, ...} => (
641 :     (f pos)
642 :     handle ex => outputExn(strm, "setPosOut", ex))
643 :     | _ => outputExn(strm, "getPosOut", IO.RandomAccessNotSupported)
644 :     (* end case *))
645 :    
646 :     (** Text stream specific operations **)
647 :     fun outputSubstr (strm as OSTRM os, ss) = let
648 :     val _ = isClosedOut (strm, "outputSubstr")
649 :     val (v, dataStart, dataLen) = substringBase ss
650 :     val {buf, pos, bufferMode, ...} = os
651 :     val bufLen = A.length buf
652 :     fun flush () = flushBuffer (strm, "outputSubstr")
653 :     fun writeDirect () = (
654 :     case !pos
655 :     of 0 => ()
656 : mblume 1381 | n => (#writeArr os (AS.slice (buf, 0, SOME n));
657 :     pos := 0)
658 : monnier 416 (* end case *);
659 : mblume 1381 #writeVec os (VS.slice (v, dataStart, SOME dataLen)))
660 :     handle ex => outputExn (strm, "outputSubstr", ex)
661 : monnier 416 fun insert copyVec = let
662 :     val bufLen = A.length buf
663 :     in
664 :     if (dataLen >= bufLen)
665 :     then writeDirect()
666 :     else let
667 :     val i = !pos
668 :     val avail = bufLen - i
669 :     in
670 :     if (avail < dataLen)
671 :     then let
672 : mblume 1350 val _ =
673 :     AS.copyVec { src = VS.slice
674 :     (v,dataStart,SOME avail),
675 :     dst = buf, di = i }
676 : mblume 1381 val _ = #writeArr os (AS.full buf)
677 : monnier 416 handle ex => (
678 :     pos := bufLen;
679 :     outputExn (strm, "outputSubstr", ex))
680 : blume 1189 val needsFlush =
681 :     copyVec(v, dataStart+avail, dataLen-avail, buf, 0)
682 : monnier 416 in
683 :     pos := dataLen-avail;
684 :     if needsFlush then flush() else ()
685 :     end
686 :     else let
687 :     val needsFlush = copyVec(v, dataStart, dataLen, buf, i)
688 :     in
689 :     pos := i + dataLen;
690 :     if (needsFlush orelse (avail = dataLen))
691 :     then flush()
692 :     else ()
693 :     end
694 :     end
695 :     end
696 :     in
697 :     case !bufferMode
698 :     of IO.NO_BUF => writeDirect()
699 :     | IO.LINE_BUF => insert lineBufCopyVec
700 :     | IO.BLOCK_BUF => insert blockBufCopyVec
701 :     (* end case *)
702 :     end
703 :    
704 :     fun setBufferMode (strm as OSTRM{bufferMode, ...}, IO.NO_BUF) = (
705 :     flushBuffer (strm, "setBufferMode");
706 :     bufferMode := IO.NO_BUF)
707 :     | setBufferMode (strm as OSTRM{bufferMode, ...}, mode) = (
708 :     isClosedOut (strm, "setBufferMode");
709 :     bufferMode := mode)
710 :     fun getBufferMode (strm as OSTRM{bufferMode, ...}) = (
711 :     isClosedOut (strm, "getBufferMode");
712 :     !bufferMode)
713 :    
714 :     end (* StreamIO *)
715 :    
716 :     type vector = V.vector
717 :     type elem = V.elem
718 :     type instream = StreamIO.instream ref
719 :     type outstream = StreamIO.outstream ref
720 :    
721 :     (** Input operations **)
722 :     fun input strm = let val (v, strm') = StreamIO.input(!strm)
723 :     in
724 :     strm := strm'; v
725 :     end
726 :     fun input1 strm = (case StreamIO.input1(!strm)
727 :     of NONE => NONE
728 :     | (SOME(elem, strm')) => (strm := strm'; SOME elem)
729 :     (* end case *))
730 :     fun inputN (strm, n) = let val (v, strm') = StreamIO.inputN (!strm, n)
731 :     in
732 :     strm := strm'; v
733 :     end
734 :     fun inputAll (strm : instream) = let
735 :     val (v, s) = StreamIO.inputAll(!strm)
736 :     in
737 :     strm := s; v
738 :     end
739 :     fun canInput (strm, n) = StreamIO.canInput (!strm, n)
740 :     fun lookahead (strm : instream) = (case StreamIO.input1(!strm)
741 :     of NONE => NONE
742 :     | (SOME(elem, _)) => SOME elem
743 :     (* end case *))
744 :     fun closeIn strm = let
745 :     val (s as StreamIO.ISTRM(buf as StreamIO.IBUF{data, ...}, _)) = !strm
746 :     (* find the end of the stream *)
747 :     fun findEOS (StreamIO.IBUF{more=ref(StreamIO.MORE buf), ...}) =
748 :     findEOS buf
749 :     | findEOS (StreamIO.IBUF{more=ref(StreamIO.EOS buf), ...}) =
750 :     findEOS buf
751 :     | findEOS (buf as StreamIO.IBUF{data, ...}) =
752 :     StreamIO.ISTRM(buf, V.length data)
753 :     in
754 :     StreamIO.closeIn s;
755 :     strm := findEOS buf
756 :     end
757 :     fun endOfStream strm = StreamIO.endOfStream(! strm)
758 :    
759 :     (** Output operations **)
760 :     fun output (strm, v) = StreamIO.output(!strm, v)
761 :     fun output1 (strm, c) = StreamIO.output1(!strm, c)
762 :     fun flushOut strm = StreamIO.flushOut(!strm)
763 :     fun closeOut strm = StreamIO.closeOut(!strm)
764 :     fun getPosOut strm = StreamIO.getPosOut(!strm)
765 :     fun setPosOut (strm, p as StreamIO.OUTP{strm=strm', ...}) = (
766 :     strm := strm'; StreamIO.setPosOut p)
767 :    
768 :     fun mkInstream (strm : StreamIO.instream) = ref strm
769 :     fun getInstream (strm : instream) = !strm
770 :     fun setInstream (strm : instream, strm') = strm := strm'
771 :    
772 :     fun mkOutstream (strm : StreamIO.outstream) = ref strm
773 :     fun getOutstream (strm : outstream) = !strm
774 :     fun setOutstream (strm : outstream, strm') = strm := strm'
775 :    
776 :     (* figure out the proper buffering mode for a given writer *)
777 :     fun bufferMode (PIO.WR{ioDesc=NONE, ...}) = IO.BLOCK_BUF
778 :     | bufferMode (PIO.WR{ioDesc=SOME iod, ...}) =
779 :     if (OS.IO.kind iod = OS.IO.Kind.tty) then IO.LINE_BUF else IO.BLOCK_BUF
780 :    
781 :     (** Open files **)
782 :     fun openIn fname =
783 :     mkInstream(StreamIO.mkInstream(OSPrimIO.openRd fname, empty))
784 :     handle ex => raise IO.Io{function="openIn", name=fname, cause=ex}
785 :     fun openOut fname = let
786 :     val wr = OSPrimIO.openWr fname
787 :     in
788 :     mkOutstream (StreamIO.mkOutstream (wr, bufferMode wr))
789 :     end
790 :     handle ex => raise IO.Io{function="openOut", name=fname, cause=ex}
791 :     fun openAppend fname =
792 :     mkOutstream(StreamIO.mkOutstream(OSPrimIO.openApp fname, IO.NO_BUF))
793 :     handle ex => raise IO.Io{function="openAppend", name=fname, cause=ex}
794 :    
795 :     (** Text stream specific operations **)
796 : mblume 1368 fun inputLine strm =
797 :     Option.map (fn (v, s) => (strm := s; v)) (StreamIO.inputLine (!strm))
798 : monnier 416 fun outputSubstr (strm, ss) = StreamIO.outputSubstr (!strm, ss)
799 :     fun openString src =
800 :     mkInstream(StreamIO.mkInstream(OSPrimIO.strReader src, empty))
801 :     handle ex => raise IO.Io{function="openIn", name="<string>", cause=ex}
802 :    
803 :     (* the standard streams *)
804 :     local
805 :     structure SIO = StreamIO
806 :     fun mkStdIn () = let
807 :     val (strm as SIO.ISTRM(SIO.IBUF{info=SIO.INFO{cleanTag, ...}, ...}, _)) =
808 :     SIO.mkInstream(OSPrimIO.stdIn(), empty)
809 :     in
810 :     CleanIO.rebindCleaner (cleanTag, {
811 :     init = fn () => (),
812 :     flush = fn () => (),
813 :     close = fn () => ()
814 :     });
815 :     strm
816 :     end
817 :     fun mkStdOut () = let
818 :     val wr = OSPrimIO.stdOut()
819 :     val (strm as SIO.OSTRM{cleanTag, ...}) =
820 :     SIO.mkOutstream(wr, bufferMode wr)
821 :     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 :     fun mkStdErr () = let
830 :     val (strm as SIO.OSTRM{cleanTag, ...}) =
831 :     SIO.mkOutstream(OSPrimIO.stdErr(), IO.NO_BUF)
832 :     in
833 :     CleanIO.rebindCleaner (cleanTag, {
834 :     init = fn () => (),
835 :     flush = fn () => SIO.flushOut strm,
836 :     close = fn () => SIO.flushOut strm
837 :     });
838 :     strm
839 :     end
840 :     in
841 :     val stdIn = mkInstream(mkStdIn())
842 :     val stdOut = mkOutstream(mkStdOut())
843 :     val stdErr = mkOutstream(mkStdErr())
844 :    
845 :     (* Establish a hook function to rebuild the I/O stack *)
846 :     val _ = CleanIO.stdStrmHook := (fn () => (
847 :     setInstream (stdIn, mkStdIn());
848 :     setOutstream (stdOut, mkStdOut());
849 :     setOutstream (stdErr, mkStdErr())))
850 :     end (* local *)
851 :    
852 :     fun print s = (output (stdOut, s); flushOut stdOut)
853 :    
854 :     fun scanStream scanFn = let
855 :     val scan = scanFn StreamIO.input1
856 :     fun doit strm = let
857 :     val instrm = getInstream strm
858 :     in
859 :     case scan instrm
860 :     of NONE => NONE
861 :     | SOME(item, instrm') => (
862 :     setInstream(strm, instrm');
863 :     SOME item)
864 :     (* end case *)
865 :     end
866 :     in
867 :     doit
868 :     end
869 :    
870 :     end (* TextIOFn *)
871 :     end
872 :    

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