1 (* Copyright (C) 2013,2017 Matthew Fluet.
2 * Copyright (C) 2002-2007 Henry Cejtin, Matthew Fluet, Suresh
3 * Jagannathan, and Stephen Weeks.
5 * MLton is released under a BSD-style license.
6 * See the file MLton-LICENSE for details.
9 signature IMPERATIVE_IO_EXTRA_ARG =
13 val alloc: int -> array
14 val unsafeSub: array * int -> elem
16 structure ArraySlice: MONO_ARRAY_SLICE
17 structure PrimIO: PRIM_IO
20 val unsafeFromArray: Array.array -> vector
22 structure VectorSlice: MONO_VECTOR_SLICE
23 sharing type Array.array
26 sharing type Array.elem
31 sharing type Array.vector
36 sharing type ArraySlice.slice
38 sharing type ArraySlice.vector_slice
43 val fileTypeFlags: Posix.FileSys.O.flags list
44 val line : {isLine: Vector.elem -> bool,
45 lineElem: Vector.elem} option
46 val mkReader: {fd: Posix.FileSys.file_desc,
48 initBlkMode: bool} -> PrimIO.reader
49 val mkWriter: {fd: Posix.FileSys.file_desc,
53 chunkSize: int} -> PrimIO.writer
54 val someElem: PrimIO.elem
55 val xlatePos : {toInt : PrimIO.pos -> Position.int,
56 fromInt : Position.int -> PrimIO.pos} option
59 functor ImperativeIOExtra (S: IMPERATIVE_IO_EXTRA_ARG): IMPERATIVE_IO_EXTRA =
64 structure StreamIO = StreamIOExtraFile (S)
66 structure PIO = PrimIO
67 structure SIO = StreamIO
69 structure AS = ArraySlice
71 structure VS = VectorSlice
73 type elem = PrimIO.elem
74 type vector = PrimIO.vector
75 type vector_slice = VS.slice
77 (* ------------------------------------------------- *)
79 (* ------------------------------------------------- *)
81 (* The following :> hides the fact that Outstream.t is an eqtype. Doing it
82 * here is much easier than putting :> on the functor result.
88 val get: t -> SIO.outstream
89 val make: SIO.outstream -> t
90 val set: t * SIO.outstream -> unit
93 datatype t = T of SIO.outstream ref
96 fun set (T r, s) = r := s
97 fun make s = T (ref s)
100 type outstream = Outstream.t
101 fun output (os, v) = SIO.output (Outstream.get os, v)
102 fun output1 (os, v) = SIO.output1 (Outstream.get os, v)
103 fun outputSlice (os, v) = SIO.outputSlice (Outstream.get os, v)
104 fun flushOut os = SIO.flushOut (Outstream.get os)
105 fun closeOut os = SIO.closeOut (Outstream.get os)
106 val mkOutstream = Outstream.make
107 val getOutstream = Outstream.get
108 val setOutstream = Outstream.set
109 val getPosOut = SIO.getPosOut o Outstream.get
110 fun setPosOut (os, outPos) = Outstream.set (os, SIO.setPosOut outPos)
112 fun newOut {appendMode, bufferMode, closeAtExit, fd, name} =
114 val writer = mkWriter {appendMode = appendMode,
115 chunkSize = chunkSize,
119 val outstream = SIO.mkOutstream'' {bufferMode = bufferMode,
120 closeAtExit = closeAtExit,
124 mkOutstream outstream
127 structure PFS = Posix.FileSys
129 val stdErr = newOut {appendMode = true,
130 bufferMode = IO.NO_BUF,
135 val newOut = fn {appendMode, closeAtExit, fd, name} =>
136 newOut {appendMode = appendMode,
137 bufferMode = if Posix.ProcEnv.isatty fd
140 closeAtExit = closeAtExit,
144 val stdOut = newOut {appendMode = true,
149 val newOut = fn {appendMode, fd, name} =>
150 newOut {appendMode = appendMode,
155 fun 'a protect' (function: string, name: string, f: unit -> 'a): 'a =
156 f () handle e => raise IO.Io {cause = e,
165 flags [irusr, iwusr, irgrp, iwgrp, iroth, iwoth]
170 ("openOut", file, fn () =>
172 val fd = PFS.createf (file, Posix.IO.O_WRONLY,
173 PFS.O.flags (PFS.O.trunc::fileTypeFlags),
181 fun openAppend file =
183 ("openAppend", file, fn () =>
185 val fd = PFS.createf (file, Posix.IO.O_WRONLY,
186 PFS.O.flags (PFS.O.append::fileTypeFlags),
195 val newOut = fn (fd, name) => newOut {fd = fd,
198 val outFd = SIO.outFd o getOutstream
200 (* ------------------------------------------------- *)
202 (* ------------------------------------------------- *)
206 | Open of {eos: bool}
207 | Stream of SIO.instream
208 (* Inv: if !first < !last then !state = Open {eos = false}
209 * if !state = Closed then !first = !last
210 * if !state = Open {eos = true} then !first = !last
213 datatype instream = In of {augmentedReader: PIO.reader,
215 first: int ref, (* index of first character *)
216 last: int ref, (* one past the index of the last char *)
221 val augmentedReader = PIO.nullRd ()
225 val reader = PIO.nullRd ()
227 fun mkInstream s = In {augmentedReader = augmentedReader,
232 state = ref (Stream s)}
235 fun setInstream (In {first, last, state, ...}, s) =
240 fun equalsIn (In {first = f, ...}, In {first = f', ...}) = f = f'
242 fun augmentedReaderSel (In {augmentedReader = PIO.RD v, ...}, sel) = sel v
244 fun readerSel (In {reader = PIO.RD v, ...}, sel) = sel v
246 fun inbufferName ib = readerSel (ib, #name)
249 case readerSel (ib, #ioDesc) of
250 NONE => raise IO.Io {cause = Fail "<no ioDesc>",
252 name = inbufferName ib}
253 | SOME ioDesc => valOf (Posix.FileSys.iodToFD ioDesc)
255 val empty = V.tabulate (0, fn _ => someElem)
258 fun make (sel, e: exn) ib =
259 case augmentedReaderSel (ib, sel) of
263 val readArr = make (#readArr, IO.BlockingNotSupported)
264 val readArrNB = make (#readArrNB, IO.NonblockingNotSupported)
265 val readVec = make (#readVec, IO.BlockingNotSupported)
268 fun 'a protect (ib, function: string, f: unit -> 'a): 'a =
269 f () handle e => raise IO.Io {cause = e,
271 name = inbufferName ib}
273 fun update (ib as In {buf, first, last, state, ...}) =
275 val i = readArr ib (AS.full buf)
278 then (state := Open {eos = true}
285 fun input (ib as In {buf, first, last, ...}) =
292 ; AS.vector (AS.slice (buf, f, SOME (l - f))))
295 val In {state, ...} = ib
301 then (state := Open {eos = false}
303 else protect (ib, "input", fn () =>
304 readVec ib (augmentedReaderSel (ib, #chunkSize)))
307 val (v, s') = SIO.input s
308 val _ = state := Stream s'
315 (* input1 will move past a temporary end of stream *)
316 fun input1 (ib as In {buf, first, last, ...}) =
322 ; SOME (A.unsafeSub (buf, f)))
325 val In {state, ...} = ib
332 (state := Open {eos = false}
335 if protect (ib, "input1", fn () => update ib)
338 ; SOME (A.sub (buf, 0)))
342 val (c, s') = SIO.input1' s
343 val _ = state := Stream s'
350 fun inputN (ib as In {buf, first, last, ...}, n) =
351 if n < 0 orelse n > V.maxLen
361 ; AS.vector (AS.slice (buf, f, SOME n)))
364 val In {state, ...} = ib
370 then (state := Open {eos = false}
374 (ib, "inputN", fn () =>
376 val readArr = readArr ib
381 else (A.update (inp, k, A.sub (buf, f + k))
391 (AS.slice (inp, i, SOME (n - i)))
394 then (state := Open {eos = true}; i)
400 then V.unsafeFromArray inp
401 else AS.vector (AS.slice (inp, 0, SOME i))
405 val (v, s') = SIO.inputN (s, n)
406 val _ = state := Stream s'
413 fun inputAll (ib as In {state, ...}) =
418 then (state := Open {eos = false}
422 (ib, "inputAll", fn () =>
424 val In {buf, first, last, ...} = ib
425 val readVec = readVec ib
428 val inp = AS.vector (AS.slice (buf, f, SOME (l - f)))
433 readVec (augmentedReaderSel (ib, #chunkSize))
436 then V.concat (List.rev inps)
437 else loop (inp :: inps)
444 val (v, s') = SIO.inputAll s
445 val _ = state := Stream s'
452 NONE => (fn ib => SOME (input ib))
453 | SOME {isLine, lineElem} =>
455 val lineVec = V.tabulate (1, fn _ => lineElem)
457 fn (ib as In {state, ...}) =>
465 (ib, "inputLine", fn () =>
467 val In {buf, first, last, ...} = ib
468 fun finish (inps, trail) =
473 val inp = V.concat (List.rev inps)
478 if !first < !last orelse update ib
484 fun loop' i = (* pre: !first <= i <= !last *)
486 fun done j = (* pre: !first < j <= !last *)
488 val inp = AS.vector (AS.slice (buf, f, SOME (j - f)))
496 else if isLine (A.sub (buf, i))
497 then finish (done (i + 1), false)
505 | _ => finish (inps, true))
511 (fn (v, s') => (state := Stream s'; v))
515 fun canInput (ib as In {state, ...}, n) =
516 if n < 0 orelse n > V.maxLen
526 (ib, "canInput", fn () =>
528 val readArrNB = readArrNB ib
529 val In {buf, first, last, ...} = ib
538 src = AS.slice (buf, f, SOME read)}
541 val size = A.length buf
545 then {read = read, eos = false}
548 val slice = AS.slice (buf, read, NONE)
549 val i = readArrNB slice
552 NONE => {read = read, eos = false}
555 then {read = read, eos = true}
558 val {read, eos} = loop read
562 then SOME (Int.min (n, read))
564 then (state := Open {eos = true}; SOME 0)
567 | Stream s => SIO.canInput (s, n)
569 fun lookahead (ib as In {buf, first, last, ...}) =
575 then SOME (A.unsafeSub (buf, f))
578 val In {state, ...} = ib
585 else if protect (ib, "lookahead", fn () => update ib)
586 then SOME (A.sub (buf, 0))
588 | Stream s => Option.map #1 (SIO.input1 s)
592 fun closeIn (ib as In {first, last, state, ...}) =
598 ; protect (ib, "closeIn", fn () => readerSel (ib, #close) ()))
599 | Stream s => SIO.closeIn s
601 fun endOfStream (ib as In {first, last, state, ...}) =
607 eos orelse not (protect (ib, "endOfStream", fn () => update ib))
608 | Stream s => SIO.endOfStream s)
610 fun mkInbuffer' {reader, closed, bufferContents} =
612 val (state, first, last, buf) =
614 then (ref Closed, ref 0, ref 0, Array.array (0, someElem))
616 val PIO.RD {chunkSize, ...} = reader
617 val buf = Array.array (chunkSize, someElem)
620 case bufferContents of
621 NONE => (ref (Open {eos = false}), ref 0)
624 then (ref (Open {eos = true}), ref 0)
625 else (V.appi (fn (i, c) => A.update (buf, i, c)) v
626 ; (ref (Open {eos = false}), ref (V.length v)))
628 (state, first, last, buf)
631 In {augmentedReader = PIO.augmentReader reader,
640 mkInbuffer' {bufferContents = NONE,
642 reader = PIO.openVector v}
644 val openInbuffers : (instream * {close: bool}) list ref = ref []
646 fun getInstream (ib as In {state, ...}) =
648 fun doit (closed: bool, bufferContents) =
650 val In {reader, ...} = ib
651 val (ibs, openInbuffers') =
652 List.partition (fn (ib', _) => equalsIn (ib, ib'))
654 val _ = openInbuffers := openInbuffers'
656 List.foldr (fn ((_, {close = close'}), close) =>
660 SIO.mkInstream'' {bufferContents = bufferContents,
661 closeAtExit = closeAtExit,
667 Closed => doit (true, NONE)
670 then doit (false, SOME (true, empty))
673 val In {buf, first, last, ...} = ib
681 AS.vector (AS.slice (buf, f,
683 else doit (false, NONE)
684 val () = state := Stream s
695 (Cleaner.atExit, fn () =>
696 List.app (fn (ib, {close}) => if close then closeIn ib else ())
699 fn {bufferContents, closeAtExit, closed, reader} =>
701 val ib = mkInbuffer' {bufferContents = bufferContents,
706 else openInbuffers := ((ib, {close = closeAtExit})
713 fun scanStream f is =
714 case f SIO.input1 (getInstream is) of
716 | SOME (v, s') => (setInstream (is, s'); SOME v)
718 val closeIn = fn ib =>
720 val _ = openInbuffers := List.filter (fn (ib',_) =>
721 not (equalsIn (ib, ib')))
727 fun newIn {bufferContents, closeAtExit, fd, name} =
729 val reader = mkReader {fd = fd, initBlkMode = true, name = name}
731 mkInbuffer'' {bufferContents = bufferContents,
732 closeAtExit = closeAtExit,
737 val newIn = fn (fd, name) =>
738 newIn {bufferContents = NONE,
743 val stdIn = newIn (PFS.stdin, "<stdin>")
747 ("openIn", file, fn () =>
749 val fd = PFS.openf (file, Posix.IO.O_RDONLY, PFS.O.flags fileTypeFlags)
756 signature IMPERATIVE_IO_ARG =
758 structure Array: MONO_ARRAY
759 (* structure ArraySlice: MONO_ARRAY_SLICE *)
760 structure StreamIO: STREAM_IO
761 structure Vector: MONO_VECTOR
762 (* structure VectorSlice: MONO_VECTOR_SLICE *)
763 (* sharing type Array.array = ArraySlice.array *)
766 (* = ArraySlice.elem *)
769 (* = VectorSlice.elem *)
772 (* = ArraySlice.vector *)
774 (* = VectorSlice.vector *)
775 (* sharing type ArraySlice.vector_slice = VectorSlice.slice *)
778 functor ImperativeIO (S: IMPERATIVE_IO_ARG): IMPERATIVE_IO =
782 structure SIO = StreamIO
785 type vector = SIO.vector
787 datatype outstream = Out of SIO.outstream ref
789 fun output (Out os, v) = SIO.output (!os, v)
790 fun output1 (Out os, v) = SIO.output1 (!os, v)
791 fun flushOut (Out os) = SIO.flushOut (!os)
792 fun closeOut (Out os) = SIO.closeOut (!os)
793 fun mkOutstream os = Out (ref os)
794 fun getOutstream (Out os) = !os
795 fun setOutstream (Out os, os') = os := os'
796 fun getPosOut (Out os) = SIO.getPosOut (!os)
797 fun setPosOut (Out os, out_pos) = os := SIO.setPosOut out_pos
799 datatype instream = In of SIO.instream ref
801 fun canInput (In is, n) = SIO.canInput (!is, n)
802 fun closeIn (In is) = SIO.closeIn (!is)
803 fun endOfStream (In is) = SIO.endOfStream (!is)
804 fun getInstream (In is) = !is
805 fun input (In is) = let val (v, is') = SIO.input (!is)
808 (* input1 will never move past a temporary end of stream *)
810 case SIO.input1 (!is) of
811 SOME (c,is') => (is := is'; SOME c)
813 fun inputAll (In is) = let val (v, is') = SIO.inputAll (!is)
816 fun inputN (In is, n) = let val (v, is') = SIO.inputN (!is, n)
819 fun lookahead (In is) =
820 Option.map #1 (SIO.input1 (!is))
821 fun mkInstream is = In (ref is)
822 fun setInstream (In is, is') = is := is'