1(* 2 Title: Standard Basis Library: ImperativeIO functor 3 Copyright David C.J. Matthews 2000, 2015, 2020 4 5 This library is free software; you can redistribute it and/or 6 modify it under the terms of the GNU Lesser General Public 7 License version 2.1 as published by the Free Software Foundation. 8 9 This library is distributed in the hope that it will be useful, 10 but WITHOUT ANY WARRANTY; without even the implied warranty of 11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 12 Lesser General Public License for more details. 13 14 You should have received a copy of the GNU Lesser General Public 15 License along with this library; if not, write to the Free Software 16 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 17*) 18 19(* This is also used in TextIO. We need "protect". *) 20functor BasicImperativeIO ( 21 structure StreamIO : STREAM_IO 22 structure Vector : MONO_VECTOR 23 structure Array : MONO_ARRAY 24 sharing type StreamIO.elem = Vector.elem = Array.elem 25 sharing type StreamIO.vector = Vector.vector = Array.vector 26) (* No signature on the result *) 27= 28struct 29 open IO 30 31 structure StreamIO = StreamIO 32 type vector = Vector.vector 33 and elem = StreamIO.elem 34 35 datatype instream = InStream of { 36 (* An imperative input stream is a reference to a lazy functional stream. 37 It is an option ref because we use a volatile ref that is set to NONE 38 if this is exported and re-imported. *) 39 fStream: StreamIO.instream option ref, 40 lock: Thread.Mutex.mutex 41 } 42 and outstream = OutStream of { 43 (* An imperative output stream is a reference to the underlying stream. 44 Unlike instream the underlying stream is also imperative but we need 45 a reference here to allow us to redirect. As with instream 46 this is a volatile ref. *) 47 fStream: StreamIO.outstream option ref 48 } 49 (* We don't need a mutex for outstream assuming := and ! are atomic 50 i.e. '!' returns either the previous value or the current one and 51 not some intermediate value. *) 52 53 (* Use no-overwrite refs for imperative streams. This is really only needed for 54 stdIn to make sure that when we call PolyML.SaveState.loadState we don't 55 overwrite any unread input by the contents of the buffer when saveState 56 was called. *) 57 58 fun mkInstream (s : StreamIO.instream) : instream = 59 let 60 val r = LibrarySupport.volatileOptionRef () 61 val () = r := SOME s 62 in 63 InStream{fStream = r, lock = Thread.Mutex.mutex()} 64 end 65 66 fun protect (InStream{fStream, lock}) f = 67 LibraryIOSupport.protect lock f fStream 68 69 (* Get and set the underlying stream. We have to interlock 70 setInstream at least. *) 71 fun getInstream s = 72 protect s ( 73 fn ref (SOME stream) => stream | _ => raise Io { name = "", function = "getInstream", cause = ClosedStream } 74 ) 75 and setInstream(InStream{fStream, lock}, s) = 76 LibraryIOSupport.protect lock (fn fStream => fStream := SOME s) fStream 77 78 (* These are just wrappers for the underlying functional calls. *) 79 fun input s = protect s 80 (fn fStream as ref(SOME stream) => 81 let 82 val (v, f') = StreamIO.input stream 83 in 84 fStream := SOME f'; 85 v 86 end 87 | _ => Vector.fromList[]) 88 89 (* We don't use StreamIO.input1 here because that never advances over 90 a temporary EOF. *) 91 fun input1 s = protect s 92 (fn fStream as ref(SOME stream) => 93 let 94 val (s, f') = StreamIO.inputN(stream, 1) 95 in 96 fStream := SOME f'; 97 if Vector.length s = 0 then NONE else SOME(Vector.sub(s, 0)) 98 end 99 | _ => NONE) 100 101 fun inputN(InStream{fStream, lock}, n) = 102 LibraryIOSupport.protect lock 103 (fn fStream as ref(SOME stream) => 104 let 105 val (v, f') = StreamIO.inputN(stream, n) 106 in 107 fStream := SOME f'; 108 v 109 end 110 | _ => Vector.fromList[]) fStream 111 112 fun inputAll s = protect s 113 (fn fStream as ref(SOME stream) => 114 let 115 val (v, f') = StreamIO.inputAll stream 116 in 117 fStream := SOME f'; 118 v 119 end 120 | _ => Vector.fromList[]) 121 122 (* These next functions only query the stream and don't affect the 123 fStream ref so don't really need interlocking. If two threads 124 call these functions simultaneously the result is non-deterministic 125 anyway. *) 126 fun canInput(InStream{fStream, lock}, n) = 127 LibraryIOSupport.protect lock 128 (fn ref(SOME stream) => StreamIO.canInput(stream, n) | _ => SOME 0) fStream 129 130 and closeIn s = 131 protect s (fn ref(SOME stream) => StreamIO.closeIn stream | _ => ()) 132 and endOfStream s = 133 protect s (fn ref(SOME stream) => StreamIO.endOfStream stream | _ => true) 134 135 fun lookahead s = protect s 136 (fn ref(SOME stream) => 137 ( 138 case StreamIO.input1 stream of 139 NONE => NONE 140 | SOME(s, _) => SOME s 141 ) 142 | _ => NONE 143 ) 144 145 (* These are simply wrappers. *) 146 147 fun mkOutstream (s : StreamIO.outstream) : outstream = 148 let 149 val r = LibrarySupport.volatileOptionRef() 150 val () = r := SOME s 151 in 152 OutStream{fStream = r} 153 end 154 155 fun getOutstream(OutStream{fStream = ref(SOME s)}) = s 156 | getOutstream _ = raise Io { name = "", function = "getOutstream", cause = ClosedStream } 157 and setOutstream(OutStream{fStream}, s) = fStream := SOME s 158 159 fun output(out, v) = StreamIO.output(getOutstream out, v) 160 and output1(out, c) = StreamIO.output1(getOutstream out, c) 161 and flushOut out = StreamIO.flushOut(getOutstream out) 162 and closeOut out = StreamIO.closeOut(getOutstream out) 163 and getPosOut out = StreamIO.getPosOut(getOutstream out) 164 165 fun setPosOut(OutStream{fStream}, p) = fStream := SOME(StreamIO.setPosOut p) 166 167 (* Add pretty printers to hide the internals. These just use the implementation streams. *) 168 local 169 open PolyML 170 fun prettyIn depth _ (InStream{ fStream = ref(SOME s), ...}) = 171 PolyML.prettyRepresentation(s, depth) 172 | prettyIn _ _ _ = PolyML.PrettyString("Instream-closed") 173 fun prettyOut depth _ (OutStream { fStream = ref(SOME s), ...}) = 174 PolyML.prettyRepresentation(s, depth) 175 | prettyOut _ _ _ = PolyML.PrettyString("Outstream-closed") 176 in 177 val () = addPrettyPrinter prettyIn 178 val () = addPrettyPrinter prettyOut 179 end 180end; 181 182(* General exported version with final signature. *) 183functor ImperativeIO ( 184 structure StreamIO : STREAM_IO 185 structure Vector : MONO_VECTOR 186 structure Array : MONO_ARRAY 187 sharing type StreamIO.elem = Vector.elem = Array.elem 188 sharing type StreamIO.vector = Vector.vector = Array.vector 189) : IMPERATIVE_IO 190 where type StreamIO.elem = StreamIO.elem 191 where type StreamIO.vector = StreamIO.vector 192 where type StreamIO.instream = StreamIO.instream 193 where type StreamIO.outstream = StreamIO.outstream 194 where type StreamIO.out_pos = StreamIO.out_pos 195 where type StreamIO.reader = StreamIO.reader 196 where type StreamIO.writer = StreamIO.writer 197 where type StreamIO.pos = StreamIO.pos 198 = 199 BasicImperativeIO(structure StreamIO = StreamIO and Vector = Vector and Array = Array); 200 201