1(* 2 Title: Standard Basis Library: Text IO 3 Copyright David C.J. Matthews 2000, 2005, 2016 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 19signature TEXT_STREAM_IO = 20sig 21 include STREAM_IO 22 where type vector = CharVector.vector 23 where type elem = Char.char 24 25 val inputLine : instream -> (string * instream) option 26 val outputSubstr : outstream * Substring.substring -> unit 27end; 28 29signature TEXT_IO = sig 30 (* include IMPERATIVE_IO *) 31 structure StreamIO : TEXT_STREAM_IO 32 where type reader = TextPrimIO.reader 33 where type writer = TextPrimIO.writer 34 where type pos = TextPrimIO.pos 35 36 type vector = StreamIO.vector 37 type elem = StreamIO.elem 38 39 type instream 40 type outstream 41 42 val input : instream -> vector 43 val input1 : instream -> elem option 44 val inputN : instream * int -> vector 45 val inputAll : instream -> vector 46 val canInput : instream * int -> int option 47 val lookahead : instream -> elem option 48 val closeIn : instream -> unit 49 val endOfStream : instream -> bool 50 val output : outstream * vector -> unit 51 val output1 : outstream * elem -> unit 52 val flushOut : outstream -> unit 53 val closeOut : outstream -> unit 54 val mkInstream : StreamIO.instream -> instream 55 val getInstream : instream -> StreamIO.instream 56 val setInstream : instream * StreamIO.instream -> unit 57 val mkOutstream : StreamIO.outstream -> outstream 58 val getOutstream : outstream -> StreamIO.outstream 59 val setOutstream : outstream * StreamIO.outstream -> unit 60 val getPosOut : outstream -> StreamIO.out_pos 61 val setPosOut : outstream * StreamIO.out_pos -> unit 62 (* End of include IMPERATIVE_IO *) 63 64 val inputLine : instream -> string option 65 val outputSubstr : outstream * Substring.substring -> unit 66 val openIn : string -> instream 67 val openOut : string -> outstream 68 val openAppend : string -> outstream 69 val openString : string -> instream 70 71 val stdIn : instream 72 val stdOut : outstream 73 val stdErr : outstream 74 75 val print : string -> unit 76 val scanStream : ((Char.char, StreamIO.instream) StringCvt.reader 77 -> ('a, StreamIO.instream) StringCvt.reader) 78 -> instream -> 'a option 79end; 80 81structure TextIO :> TEXT_IO = struct 82 open IO 83 84 type vector = String.string 85 and elem = Char.char 86 87 exception Interrupt = RunCall.Interrupt 88 89 (* Called after any exception in the lower level reader or 90 writer to map any exception other than Io into Io. *) 91 fun mapToIo (io as Io _, _, _) = io 92 | mapToIo (Interrupt, _, _) = Interrupt 93 | mapToIo (nonIo, name, caller) = 94 Io { name = name, function = caller, cause = nonIo } 95 96 (* Functional IO Layer. *) 97 98 structure TextStreamIO = 99 struct 100 structure BasicTextStreamIO = BasicStreamIO( 101 structure PrimIO = TextPrimIO 102 structure Vector = CharVector 103 structure Array = CharArray 104 structure VectorSlice = CharVectorSlice 105 structure ArraySlice = CharArraySlice 106 val someElem : PrimIO.elem = #" " 107 ); 108 109 open BasicTextStreamIO 110 111 (* Input a line. Adds a newline if the file ends without one. *) 112 fun inputLine f = 113 let 114 (* Read a sequence of blocks until we get a newline or EOF. *) 115 fun inputBlocks read f = 116 let 117 (* Read the next block and see how big it is. *) 118 val (blk, f') = input f 119 val length = String.size blk 120 121 (* See if it contains a newline and if so where. *) 122 fun newlinePos i = 123 if i = length then length+1 124 else if String.sub(blk, i) = #"\n" 125 then i+1 (* Return characters including newline. *) 126 else newlinePos (i+1) 127 val nlPos = newlinePos 0 128 in 129 if length = 0 (* EOF *) 130 then ( 131 (* If we have not read anything at all we return NONE 132 otherwise return what we had with a newline added. *) 133 case read of 134 [] => NONE 135 | _ => SOME(String.concat(List.rev("\n"::read)), f) 136 ) 137 else if nlPos > length 138 then inputBlocks (blk::read) f' (* No newline - get another block.. *) 139 else (* The string we read included a newline. *) 140 let 141 (* Reread all up to and including the newline 142 and return the stream which gives us the rest. *) 143 val (b, f') = inputN(f, nlPos) 144 in 145 SOME(String.concat(List.rev(b::read)), f') 146 end 147 end 148 in 149 (* If we are at end-of-stream we return NONE. Since this is a functional stream 150 that means we will always return NONE for a given f (i.e. there's no 151 temporary end-of-stream to be cleared). *) 152 inputBlocks [] f 153 end 154 155 (* StreamIO treats line buffering on output as block buffering 156 since it has no concept of a line separator. *) 157 fun output(f, v) = 158 case getBufferMode f of 159 LINE_BUF => 160 let 161 val vecLen = CharVector.length v 162 (* Find the last newline character in the string. *) 163 fun lastNewline 0 = 0 164 | lastNewline i = 165 if CharVector.sub(v, i-1) = #"\n" then i 166 else lastNewline(i-1) 167 val newLinePos = lastNewline vecLen 168 in 169 if newLinePos = 0 170 then (* No newlines in it. *) 171 BasicTextStreamIO.output(f, v) 172 else (* There's at least one newline. *) 173 ( 174 outputVec(f, CharVectorSlice.slice(v, 0, SOME newLinePos)); 175 flushOut f; 176 outputVec(f, CharVectorSlice.slice(v, newLinePos, NONE)) 177 ) 178 end 179 180 | _ => BasicTextStreamIO.output(f, v) (* Not line buffering. *) 181 182 (* This could be defined in terms of output but the underlying 183 output1 function is likely to be more efficient. *) 184 fun output1(f, c) = 185 ( 186 BasicTextStreamIO.output1(f, c); 187 if c = #"\n" andalso getBufferMode f = LINE_BUF 188 then flushOut f else () 189 ) 190 end (* StreamIO. *) 191 192 193 (* The imperative IO streams *) 194 structure ImpIO = BasicImperativeIO( 195 structure StreamIO = TextStreamIO 196 structure Vector = CharVector 197 structure Array = CharArray) 198 199 open ImpIO 200 (* Now define StreamIO as our extended StreamIO *) 201 202 (* Replace the StreamIO from ImpIO by our version. *) 203 structure StreamIO = 204 struct 205 open TextStreamIO 206 207 val outputSubstr = outputVec 208 end 209 210 open Thread.Thread 211 open Thread.Mutex 212 open LibrarySupport.CharArray 213 type fileDescr = OS.IO.iodesc; 214 type address = LibrarySupport.address 215 (* We have to declare doIo separately depending on the 216 types of the arguments. It's possible to get round this 217 but that would result in an extra call to run_call3 for 218 each io call. *) 219 local 220 val doIo: int*int*string -> fileDescr 221 = RunCall.rtsCallFull3 "PolyBasicIOGeneral" 222 in 223 val stdInDesc: fileDescr = RunCall.unsafeCast 0 224 225 fun sys_open_in_text name = doIo(3, 0, name) 226 and sys_open_out_text name = doIo(5, 0, name) 227 and sys_open_append_text name = doIo(13, 0, name) 228 end 229 230 local 231 val doIo = RunCall.rtsCallFull3 "PolyBasicIOGeneral" 232 in 233 fun sys_get_buffsize (strm: fileDescr): int = doIo(15, strm, 0) 234 end 235 236 (* Create the primitive IO functions and add the higher layers. *) 237 fun wrapInFileDescr(n, name) = 238 let 239 val textPrimRd = 240 LibraryIOSupport.wrapInFileDescr{fd=n, 241 name=name, initBlkMode=true} 242 val streamIo = StreamIO.mkInstream(textPrimRd, "") 243 in 244 ImpIO.mkInstream streamIo 245 end 246 247 fun wrapOutFileDescr(n, name, buffering, isAppend) = 248 let 249 val buffSize = sys_get_buffsize n 250 val textPrimWr = 251 LibraryIOSupport.wrapOutFileDescr{fd=n, 252 name=name, appendMode=isAppend, initBlkMode=true, chunkSize=buffSize} 253 (* Construct a stream. *) 254 val streamIo = StreamIO.mkOutstream(textPrimWr, buffering) 255 in 256 mkOutstream streamIo 257 end 258 259 (* Open a file for output. *) 260 fun openOut s = 261 let 262 val f = 263 sys_open_out_text s 264 handle exn => raise mapToIo(exn, s, "TextIO.openOut") 265 (* Look at the stream to see what kind of buffering to use. *) 266 val k = OS.IO.kind f 267 in 268 wrapOutFileDescr (f, s, 269 if k = OS.IO.Kind.tty then IO.LINE_BUF else IO.BLOCK_BUF, 270 false (* Not append *)) 271 end 272 273 fun openAppend s = 274 let 275 val f = 276 sys_open_append_text s 277 handle exn => raise mapToIo(exn, s, "TextIO.openAppend") 278 val k = OS.IO.kind f 279 in 280 wrapOutFileDescr (f, s, 281 if k = OS.IO.Kind.tty then IO.LINE_BUF else IO.BLOCK_BUF, 282 true (* setPos will not work. *)) 283 end 284 285 (* Open a file for input. *) 286 fun openIn s = 287 let 288 val f = 289 sys_open_in_text s 290 handle exn => raise mapToIo(exn, s, "TextIO.openIn") 291 in 292 wrapInFileDescr(f, s) 293 end 294 295 (* Get the entries for standard input, standard output and standard error. *) 296 val stdIn = wrapInFileDescr(stdInDesc, "stdIn") 297 298 local 299 (* On startup reset stdIn to the original stream. Among other things this clears 300 any data that may have been in the buffer when we exported. *) 301 fun onStartUp () = 302 let 303 val textPrimRd = 304 LibraryIOSupport.wrapInFileDescr{fd=stdInDesc, 305 name="stdIn", initBlkMode=true} 306 val streamIo = StreamIO.mkInstream(textPrimRd, "") 307 in 308 ImpIO.setInstream(stdIn, streamIo) 309 end 310 in 311 (* Set up an onEntry handler so that this is always installed. *) 312 val () = PolyML.onEntry onStartUp 313 end; 314 315 (* We may want to consider unbuffered output or even linking stdOut with stdIn 316 so that any unbuffered 317 output is flushed before reading from stdIn. That's the way that stdio 318 works to ensure that prompts are written out. *) 319 (* PROBLEM: The following declaration is evaluated when this structure is 320 created, not at the start of the session. The buffering will be set 321 permanently to the buffering in effect at that point. 322 Two solutions are possible. One is to define special versions of the 323 "write" functions to examine the stream whenever they are called and 324 decide whether to change the buffering. Another is simply to set it 325 to unbuffered. That can be changed, though, which may not be 326 satisfactory. *) 327 (* I've changed this from NO_BUF to LINE_BUF which should improve 328 the performance. An alternative might be to set up an "OnEntry" 329 call which would examine the stream and decide what kind of 330 buffering to use. DCJM 1/9/00. *) 331 val stdOut = 332 let 333 val f: fileDescr = RunCall.unsafeCast 1 334 in 335 wrapOutFileDescr (f, "stdOut", IO.LINE_BUF 336 (* if System_is_term f then IO.LINE_BUF else IO.BLOCK_BUF *), 337 false) 338 end 339 340 val stdErr = 341 let 342 val f: fileDescr = RunCall.unsafeCast 2 343 in 344 wrapOutFileDescr (f, "stdErr", 345 IO.NO_BUF (* Defined to be unbuffered. *), 346 false) 347 end 348 349 local 350 (* This requires access to the underlying representation in order to be 351 able to lock the stream while reading the line. This ensures that 352 if multiple threads are reading lines from a stream each thread 353 will get a complete line. *) 354 fun inputLine' fStream = 355 let 356 val f = ! fStream 357 in 358 case StreamIO.inputLine f of 359 NONE => 360 let 361 (* It's not clear what should happen here. Assume that this clears any 362 temporary EOF. *) 363 val (_, f') = StreamIO.input f 364 in 365 fStream := f'; 366 NONE 367 end 368 | SOME (s, f') => ( fStream := f'; SOME s ) 369 end 370 in 371 fun inputLine s = ImpIO.protect s inputLine' 372 end 373 374 fun outputSubstr(f, s) = StreamIO.outputSubstr(getOutstream f, s) 375 376 fun print s = (output(stdOut, s); flushOut stdOut) 377 378 (* Open a string as an input stream. It would be possible to define this using 379 the string as the argument to mkInstream and a null reader. This way gives 380 more flexibility since it allows for random access to the string. *) 381 fun openString (s: string) : instream = 382 let 383 val stringLength = String.size s 384 val posN: int ref = ref 0 385 386 (* We can read from the string until it is exhausted. *) 387 fun readVec (len: int): vector = 388 let 389 val l = Int.min(len, stringLength - !posN) 390 val v = String.substring(s, !posN, l) 391 in 392 posN := !posN + l; 393 v 394 end 395 396 (* Closing it simply exhausts the input. *) 397 fun close () : unit = (posN := stringLength) 398 and avail () : int option = SOME(stringLength - ! posN) 399 and readVecNB l = SOME(readVec l) 400 and block () = () 401 and canInput () = true 402 and getPos () = Position.fromInt(!posN) 403 and setPos n = posN := Position.toInt n 404 and endPos () = Position.fromInt stringLength 405 406 val textPrimRd = 407 TextPrimIO.RD { 408 name = "StringPrimIO", 409 chunkSize = stringLength, (* Most efficient to read the whole string. *) 410 readVec = SOME readVec, 411 readArr = NONE, (* Can be synthesised. *) 412 readVecNB = SOME readVecNB, 413 readArrNB = NONE, (* Can be synthesised. *) 414 block = SOME block, 415 canInput = SOME canInput, 416 avail = avail, 417 getPos = SOME getPos, 418 setPos = SOME setPos, 419 endPos = SOME endPos, 420 verifyPos = SOME getPos, 421 close = close, 422 ioDesc = NONE 423 } 424 val streamIo = StreamIO.mkInstream(textPrimRd, "") 425 in 426 ImpIO.mkInstream streamIo 427 end 428 429 fun scanStream scanFn strm = 430 let 431 val f = getInstream strm 432 in 433 case (scanFn StreamIO.input1 f) of 434 NONE => NONE 435 | SOME(v, f') => 436 ( 437 setInstream(strm, f'); 438 SOME v 439 ) 440 441 end 442end; 443 444(* Available unqualified at top-level. *) 445val print = TextIO.print; 446