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/cml/src/IO/bin-io-fn.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/cml/src/IO/bin-io-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 167 - (view) (download)

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

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