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

Annotation of /sml/branches/SMLNJ/src/compiler/PervEnv/IO/text-io-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 167 - (view) (download)

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

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