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

Annotation of /sml/trunk/src/cml/src/IO/new-bin-io-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 844 - (view) (download)

1 : blume 844 (* 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 :     fun mkInstream (reader, data) = let
327 :     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 :     (** What should we do about the position in this case ?? **)
340 :     (** 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 :     val basePos =
345 :     if (V.length data = 0)
346 :     then getPos()
347 :     else NONE
348 :     val buf = IBUF { basePos = basePos, data = data,
349 :     info = info, more = more }
350 :     val strm = ISTRM(buf, 0)
351 :     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 :     (*
372 :     (** Position operations on instreams **)
373 :     datatype in_pos = INP of {
374 :     base : pos,
375 :     offset : int,
376 :     info : info
377 :     }
378 :     *)
379 :    
380 :     (*
381 :     fun getPosIn (ISTRM(buf, pos)) = (case buf
382 :     of IBUF{basePos=NONE, info, ...} =>
383 :     inputExn (info, "getPosIn", IO.RandomAccessNotSupported)
384 :     | IBUF{basePos=SOME p, info, ...} => INP{
385 :     base = p, offset = pos, info = info
386 :     }
387 :     (* end case *))
388 :     *)
389 :    
390 :    
391 :     (*
392 :     fun filePosIn (INP{base, offset, ...}) =
393 :     Position.+(base, Position.fromInt offset)
394 :     *)
395 :     fun filePosIn (ISTRM(buf, pos)) =
396 :     case buf of
397 :     IBUF{basePos=NONE, info, ... } =>
398 :     inputExn (info, "filePosIn", IO.RandomAccessNotSupported)
399 :     | IBUF{basePos=SOME b, ... } =>
400 :     Position.+(b, Position.fromInt pos)
401 :     (*
402 :     fun setPosIn (pos as INP{info as INFO{reader, ...}, ...}) = let
403 :     val fpos = filePosIn pos
404 :     val (PIO.RD rd) = reader
405 :     in
406 :     terminate info;
407 :     valOf (#setPos rd) fpos;
408 :     mkInstream (PIO.RD rd, empty)
409 :     end
410 :     *)
411 :    
412 :    
413 :     (*** Output streams ***)
414 :    
415 :     (* an output stream is implemented as a monitor using an mvar to
416 :     * hold its data.
417 :     *)
418 :    
419 :     datatype ostrm_info = OSTRM of {
420 :     buf : A.array,
421 :     pos : int ref,
422 :     closed : bool ref,
423 :     bufferMode : IO.buffer_mode ref,
424 :     writer : writer,
425 :     writeArr : {buf : A.array, i : int, sz : int option} -> unit,
426 :     writeVec : {buf : V.vector, i : int, sz : int option} -> unit,
427 :     cleanTag : CleanIO.tag
428 :     }
429 :    
430 :     type outstream = ostrm_info SV.mvar
431 :    
432 :     fun outputExn (OSTRM{writer=PIO.WR{name, ...}, ...}, mlOp, exn) =
433 :     raise IO.Io{function=mlOp, name=name, cause=exn}
434 :    
435 :     (* lock access to the stream and make sure that it is not closed. *)
436 :     fun lockAndChkClosedOut (strmMV, mlOp) = (case SV.mTake strmMV
437 :     of (strm as OSTRM({closed=ref true, ...})) => (
438 :     SV.mPut (strmMV, strm);
439 :     outputExn (strm, mlOp, IO.ClosedStream))
440 :     | strm => strm
441 :     (* end case *))
442 :    
443 :     fun flushBuffer (strmMV, strm as OSTRM{buf, pos, writeArr, ...}, mlOp) = (
444 :     case !pos
445 :     of 0 => ()
446 :     | n => ((
447 :     writeArr {buf=buf, i=0, sz=SOME n}; pos := 0)
448 :     handle ex => (
449 :     SV.mPut(strmMV, strm); outputExn (strm, mlOp, ex)))
450 :     (* end case *))
451 :    
452 :     fun output (strmMV, v) = let
453 :     val (strm as OSTRM os) = lockAndChkClosedOut (strmMV, "output")
454 :     fun release () = SV.mPut (strmMV, strm)
455 :     val {buf, pos, bufferMode, ...} = os
456 :     fun flush () = flushBuffer (strmMV, strm, "output")
457 :     fun flushAll () = (#writeArr os {buf=buf, i=0, sz=NONE}
458 :     handle ex => (release(); outputExn (strm, "output", ex)))
459 :     fun writeDirect () = (
460 :     case !pos
461 :     of 0 => ()
462 :     | n => (#writeArr os {buf=buf, i=0, sz=SOME n}; pos := 0)
463 :     (* end case *);
464 :     #writeVec os {buf=v, i=0, sz=NONE})
465 :     handle ex => (release(); outputExn (strm, "output", ex))
466 :     fun insert copyVec = let
467 :     val bufLen = A.length buf
468 :     val dataLen = V.length v
469 :     in
470 :     if (dataLen >= bufLen)
471 :     then writeDirect()
472 :     else let
473 :     val i = !pos
474 :     val avail = bufLen - i
475 :     in
476 :     if (avail < dataLen)
477 :     then (
478 :     copyVec(v, 0, avail, buf, i);
479 :     flushAll();
480 :     copyVec(v, avail, dataLen-avail, buf, 0);
481 :     pos := dataLen-avail)
482 :     else (
483 :     copyVec(v, 0, dataLen, buf, i);
484 :     pos := i + dataLen;
485 :     if (avail = dataLen) then flush() else ())
486 :     end
487 :     end
488 :     in
489 :     case !bufferMode
490 :     of IO.NO_BUF => writeDirect ()
491 :     | _ => let
492 :     fun copyVec (src, srcI, srcLen, dst, dstI) = A.copyVec {
493 :     src = src, si = srcI, len = SOME srcLen,
494 :     dst = dst, di = dstI
495 :     }
496 :     in
497 :     insert copyVec
498 :     end
499 :     (* end case *);
500 :     release()
501 :     end
502 :    
503 :     fun output1 (strmMV, elem) = let
504 :     val (strm as OSTRM{buf, pos, bufferMode, writeArr, ...}) =
505 :     lockAndChkClosedOut (strmMV, "output1")
506 :     fun release () = SV.mPut (strmMV, strm)
507 :     in
508 :     case !bufferMode
509 :     of IO.NO_BUF => (
510 :     arrUpdate (buf, 0, elem);
511 :     writeArr {buf=buf, i=0, sz=SOME 1}
512 :     handle ex => (release(); outputExn (strm, "output1", ex)))
513 :     | _ => let val i = !pos val i' = i+1
514 :     in
515 :     arrUpdate (buf, i, elem); pos := i';
516 :     if (i' = A.length buf)
517 :     then flushBuffer (strmMV, strm, "output1")
518 :     else ()
519 :     end
520 :     (* end case *);
521 :     release()
522 :     end
523 :    
524 :     fun flushOut strmMV = let
525 :     val strm = lockAndChkClosedOut (strmMV, "flushOut")
526 :     in
527 :     flushBuffer (strmMV, strm, "flushOut");
528 :     SV.mPut (strmMV, strm)
529 :     end
530 :    
531 :     fun closeOut strmMV = let
532 :     val (strm as OSTRM{writer=PIO.WR{close, ...}, closed, cleanTag, ...}) =
533 :     SV.mTake strmMV
534 :     in
535 :     if !closed
536 :     then ()
537 :     else (
538 :     flushBuffer (strmMV, strm, "closeOut");
539 :     closed := true;
540 :     CleanIO.removeCleaner cleanTag;
541 :     close());
542 :     SV.mPut (strmMV, strm)
543 :     end
544 :    
545 :     fun mkOutstream (wr as PIO.WR{chunkSize, writeArr, writeVec, ...}, mode) =
546 :     let
547 :     fun iterate f (buf, i, sz) = let
548 :     fun lp (_, 0) = ()
549 :     | lp (i, n) = let val n' = f{buf=buf, i=i, sz=SOME n}
550 :     in lp (i+n', n-n') end
551 :     in
552 :     lp (i, sz)
553 :     end
554 :     fun writeArr' {buf, i, sz} = let
555 :     val len = (case sz
556 :     of NONE => A.length buf - i
557 :     | (SOME n) => n
558 :     (* end case *))
559 :     in
560 :     iterate writeArr (buf, i, len)
561 :     end
562 :     fun writeVec' {buf, i, sz} = let
563 :     val len = (case sz
564 :     of NONE => V.length buf - i
565 :     | (SOME n) => n
566 :     (* end case *))
567 :     in
568 :     iterate writeVec (buf, i, len)
569 :     end
570 :     (* install a dummy cleaner *)
571 :     val tag = CleanIO.addCleaner dummyCleaner
572 :     val strm = SV.mVarInit (OSTRM{
573 :     buf = A.array(chunkSize, someElem),
574 :     pos = ref 0,
575 :     closed = ref false,
576 :     bufferMode = ref mode,
577 :     writer = wr,
578 :     writeArr = writeArr',
579 :     writeVec = writeVec',
580 :     cleanTag = tag
581 :     })
582 :     in
583 :     CleanIO.rebindCleaner (tag, fn () => closeOut strm);
584 :     strm
585 :     end
586 :    
587 :     fun getWriter strmMV = let
588 :     val (strm as OSTRM{writer, bufferMode, ...}) =
589 :     lockAndChkClosedOut (strmMV, "getWriter")
590 :     in
591 :     (writer, !bufferMode) before SV.mPut(strmMV, strm)
592 :     end
593 :    
594 :     (** Position operations on outstreams **)
595 :     datatype out_pos = OUTP of {
596 :     pos : PIO.pos,
597 :     strm : outstream
598 :     }
599 :    
600 :     fun getPosOut strmMV = let
601 :     val (strm as OSTRM{writer, ...}) =
602 :     lockAndChkClosedOut (strmMV, "getWriter")
603 :     fun release () = SV.mPut(strmMV, strm)
604 :     in
605 :     flushBuffer (strmMV, strm, "getPosOut");
606 :     case writer
607 :     of PIO.WR{getPos=SOME f, ...} => (
608 :     OUTP{pos = f(), strm = strmMV}
609 :     handle ex => (release(); outputExn(strm, "getPosOut", ex)))
610 :     | _ => (
611 :     release();
612 :     outputExn(strm, "getPosOut", IO.RandomAccessNotSupported))
613 :     (* end case *)
614 :     before release()
615 :     end
616 :     fun filePosOut (OUTP{pos, strm=strmMV}) = (
617 :     SV.mPut (strmMV, lockAndChkClosedOut (strmMV, "filePosOut"));
618 :     pos)
619 :     fun setPosOut (OUTP{pos, strm=strmMV}) = let
620 :     val (strm as OSTRM{writer, ...}) =
621 :     lockAndChkClosedOut (strmMV, "setPosOut")
622 :     fun release () = SV.mPut(strmMV, strm)
623 :     in
624 :     case writer
625 :     of PIO.WR{setPos=SOME f, ...} => (
626 :     (f pos)
627 :     handle ex => (release(); outputExn(strm, "setPosOut", ex)))
628 :     | _ => (
629 :     release();
630 :     outputExn(strm, "getPosOut", IO.RandomAccessNotSupported))
631 :     (* end case *);
632 :     release()
633 :     end
634 :    
635 :     fun setBufferMode (strmMV, mode) = let
636 :     val (strm as OSTRM{bufferMode, ...}) =
637 :     lockAndChkClosedOut (strmMV, "setBufferMode")
638 :     in
639 :     if (mode = IO.NO_BUF)
640 :     then flushBuffer (strmMV, strm, "setBufferMode")
641 :     else ();
642 :     bufferMode := mode;
643 :     SV.mPut (strmMV, strm)
644 :     end
645 :     fun getBufferMode strmMV = let
646 :     (** should we be checking for closed streams here??? **)
647 :     val (strm as OSTRM{bufferMode, ...}) =
648 :     lockAndChkClosedOut (strmMV, "getBufferMode")
649 :     in
650 :     !bufferMode before SV.mPut (strmMV, strm)
651 :     end
652 :    
653 :     end (* StreamIO *)
654 :    
655 :     type vector = V.vector
656 :     type elem = V.elem
657 :     type instream = StreamIO.instream SV.mvar
658 :     type outstream = StreamIO.outstream SV.mvar
659 :    
660 :     (** Input operations **)
661 :     fun input strm = let val (v, strm') = StreamIO.input(SV.mTake strm)
662 :     in
663 :     SV.mPut (strm, strm'); v
664 :     end
665 :     fun input1 strm = (case StreamIO.input1(SV.mTake strm)
666 :     of NONE => NONE
667 :     | (SOME(elem, strm')) => (SV.mPut (strm, strm'); SOME elem)
668 :     (* end case *))
669 :     fun inputN (strm, n) = let val (v, strm') = StreamIO.inputN (SV.mTake strm, n)
670 :     in
671 :     SV.mPut (strm, strm'); v
672 :     end
673 :     fun inputAll (strm : instream) = let
674 :     val (v, strm') = StreamIO.inputAll(SV.mTake strm)
675 :     in
676 :     SV.mPut (strm, strm'); v
677 :     end
678 :     fun input1Evt _ = raise Fail "input1Evt unimplemented"
679 :     fun inputEvt _ = raise Fail "inputEvt unimplemented"
680 :     fun inputNEvt _ = raise Fail "inputNEvt unimplemented"
681 :     fun inputAllEvt _ = raise Fail "inputAllEvt unimplemented"
682 :     fun canInput (strm, n) = StreamIO.canInput (SV.mGet strm, n)
683 :     fun lookahead (strm : instream) = (case StreamIO.input1(SV.mGet strm)
684 :     of NONE => NONE
685 :     | (SOME(elem, _)) => SOME elem
686 :     (* end case *))
687 :     fun closeIn strm = let
688 :     val (s as StreamIO.ISTRM(buf as StreamIO.IBUF{data, ...}, _)) =
689 :     SV.mTake strm
690 :     in
691 :     StreamIO.closeIn s;
692 :     SV.mPut(strm, StreamIO.findEOS buf)
693 :     end
694 :     fun endOfStream strm = StreamIO.endOfStream(SV.mGet strm)
695 :     (*
696 :     fun getPosIn strm = StreamIO.getPosIn(SV.mGet strm)
697 :     fun setPosIn (strm, p) = mUpdate(strm, StreamIO.setPosIn p)
698 :     *)
699 :    
700 :     (** Output operations **)
701 :     fun output (strm, v) = StreamIO.output(SV.mGet strm, v)
702 :     fun output1 (strm, c) = StreamIO.output1(SV.mGet strm, c)
703 :     fun flushOut strm = StreamIO.flushOut(SV.mGet strm)
704 :     fun closeOut strm = StreamIO.closeOut(SV.mGet strm)
705 :     fun getPosOut strm = StreamIO.getPosOut(SV.mGet strm)
706 :     fun setPosOut (strm, p as StreamIO.OUTP{strm=strm', ...}) = (
707 :     mUpdate(strm, strm'); StreamIO.setPosOut p)
708 :    
709 :     fun mkInstream (strm : StreamIO.instream) = SV.mVarInit strm
710 :     fun getInstream (strm : instream) = SV.mGet strm
711 :     fun setInstream (strm : instream, strm') = mUpdate(strm, strm')
712 :    
713 :     fun mkOutstream (strm : StreamIO.outstream) = SV.mVarInit strm
714 :     fun getOutstream (strm : outstream) = SV.mGet strm
715 :     fun setOutstream (strm : outstream, strm') = mUpdate(strm, strm')
716 :    
717 :     (** Open files **)
718 :     fun openIn fname =
719 :     mkInstream(StreamIO.mkInstream(OSPrimIO.openRd fname, empty))
720 :     handle ex => raise IO.Io{function="openIn", name=fname, cause=ex}
721 :     fun openOut fname =
722 :     mkOutstream(StreamIO.mkOutstream(OSPrimIO.openWr fname, IO.BLOCK_BUF))
723 :     handle ex => raise IO.Io{function="openOut", name=fname, cause=ex}
724 :     fun openAppend fname =
725 :     mkOutstream(StreamIO.mkOutstream(OSPrimIO.openApp fname, IO.NO_BUF))
726 :     handle ex => raise IO.Io{function="openAppend", name=fname, cause=ex}
727 :    
728 :     end (* BinIOFn *)

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