ghc/lib/std/PrelIO.lhs

   1 %
   2 % (c) The GRAP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[PrelIO]{Module @PrelIO@}
   5
   6 This module defines all basic IO operations.
   7 These are needed for the IO operations exported by Prelude,
   8 but as it happens they also do everything required by library
   9 module IO.
  10
  11
  12 \begin{code}
  13 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
  14
  15 module PrelIO where
  16
  17 import PrelBase
  18
  19 import PrelIOBase
  20 import PrelHandle       -- much of the real stuff is in here
  21
  22 import PrelRead         ( readParen, Read(..), reads, lex,
  23                           readIO
  24                         )
  25 import PrelShow
  26 import PrelMaybe        ( Either(..), Maybe(..) )
  27 import PrelAddr         ( Addr(..), nullAddr )
  28 import PrelByteArr      ( ByteArray )
  29 import PrelPack         ( unpackNBytesAccST )
  30 import PrelException    ( ioError, catch )
  31 import PrelConc
  32 \end{code}
  33
  34
  35
  36 %*********************************************************
  37 %*                                                       *
  38 \subsection{Standard IO}
  39 %*                                                       *
  40 %*********************************************************
  41
  42 The Prelude has from Day 1 provided a collection of common
  43 IO functions. We define these here, but let the Prelude
  44 export them.
  45
  46 \begin{code}
  47 putChar         :: Char -> IO ()
  48 putChar c       =  hPutChar stdout c
  49
  50 putStr          :: String -> IO ()
  51 putStr s        =  hPutStr stdout s
  52
  53 putStrLn        :: String -> IO ()
  54 putStrLn s      =  do putStr s
  55                       putChar '\n'
  56
  57 print           :: Show a => a -> IO ()
  58 print x         =  putStrLn (show x)
  59
  60 getChar         :: IO Char
  61 getChar         =  hGetChar stdin
  62
  63 getLine         :: IO String
  64 getLine         =  hGetLine stdin
  65
  66 getContents     :: IO String
  67 getContents     =  hGetContents stdin
  68
  69 interact        ::  (String -> String) -> IO ()
  70 interact f      =   do s <- getContents
  71                        putStr (f s)
  72
  73 readFile        :: FilePath -> IO String
  74 readFile name   =  openFile name ReadMode >>= hGetContents
  75
  76 writeFile       :: FilePath -> String -> IO ()
  77 writeFile name str = do
  78     hdl <- openFile name WriteMode
  79     hPutStr hdl str
  80     hClose hdl
  81
  82 appendFile      :: FilePath -> String -> IO ()
  83 appendFile name str = do
  84     hdl <- openFile name AppendMode
  85     hPutStr hdl str
  86     hClose hdl
  87
  88 readLn          :: Read a => IO a
  89 readLn          =  do l <- getLine
  90                       r <- readIO l
  91                       return r
  92 \end{code}
  93
  94
  95 %*********************************************************
  96 %*                                                      *
  97 \subsection{Simple input operations}
  98 %*                                                      *
  99 %*********************************************************
 100
 101 Computation @hReady hdl@ indicates whether at least
 102 one item is available for input from handle {\em hdl}.
 103
 104 @hWaitForInput@ is the generalisation, wait for \tr{n} milliseconds
 105 before deciding whether the Handle has run dry or not.
 106
 107 If @hWaitForInput@ finds anything in the Handle's buffer, it immediately returns.
 108 If not, it tries to read from the underlying OS handle. Notice that
 109 for buffered Handles connected to terminals this means waiting until a complete
 110 line is available.
 111
 112 \begin{code}
 113 hReady :: Handle -> IO Bool
 114 hReady h = hWaitForInput h 0
 115
 116 hWaitForInput :: Handle -> Int -> IO Bool
 117 hWaitForInput handle msecs =
 118     wantReadableHandle "hWaitForInput" handle $ \ handle_ -> do
 119     rc       <- inputReady (haFO__ handle_) (msecs::Int)     -- ConcHask: SAFE, won't block
 120     case (rc::Int) of
 121       0 -> return False
 122       1 -> return True
 123       _ -> constructErrorAndFail "hWaitForInput"
 124 \end{code}
 125
 126 @hGetChar hdl@ reads the next character from handle @hdl@,
 127 blocking until a character is available.
 128
 129 \begin{code}
 130 hGetChar :: Handle -> IO Char
 131 hGetChar handle = do
 132   c <- mayBlockRead "hGetChar" handle fileGetc
 133   return (chr c)
 134
 135 {-
 136   If EOF is reached before EOL is encountered, ignore the
 137   EOF and return the partial line. Next attempt at calling
 138   hGetLine on the handle will yield an EOF IO exception though.
 139 -}
 140 hGetLine :: Handle -> IO String
 141 hGetLine h = do
 142   c <- hGetChar h
 143   if c == '\n' then
 144      return ""
 145    else do
 146     l <- getRest
 147     return (c:l)
 148  where
 149   getRest = do
 150     c <-
 151       catch
 152         (hGetChar h)
 153         (\ err -> do
 154           if isEOFError err then
 155              return '\n'
 156            else
 157              ioError err)
 158     if c == '\n' then
 159        return ""
 160      else do
 161        s <- getRest
 162        return (c:s)
 163
 164 \end{code}
 165
 166 @hLookahead hdl@ returns the next character from handle @hdl@
 167 without removing it from the input buffer, blocking until a
 168 character is available.
 169
 170 \begin{code}
 171 hLookAhead :: Handle -> IO Char
 172 hLookAhead handle = do
 173   rc <- mayBlockRead "hLookAhead" handle fileLookAhead
 174   return (chr rc)
 175 \end{code}
 176
 177
 178 %*********************************************************
 179 %*                                                      *
 180 \subsection{Getting the entire contents of a handle}
 181 %*                                                      *
 182 %*********************************************************
 183
 184 @hGetContents hdl@ returns the list of characters corresponding
 185 to the unread portion of the channel or file managed by @hdl@,
 186 which is made semi-closed.
 187
 188 \begin{code}
 189 hGetContents :: Handle -> IO String
 190 hGetContents handle =
 191         -- can't use wantReadableHandle here, because we want to side effect
 192         -- the handle.
 193     withHandle handle $ \ handle_ -> do
 194     case haType__ handle_ of
 195       ErrorHandle theError -> ioError theError
 196       ClosedHandle         -> ioe_closedHandle "hGetContents" handle
 197       SemiClosedHandle     -> ioe_closedHandle "hGetContents" handle
 198       AppendHandle         -> ioError not_readable_error
 199       WriteHandle          -> ioError not_readable_error
 200       _ -> do
 201           {-
 202             To avoid introducing an extra layer of buffering here,
 203             we provide three lazy read methods, based on character,
 204             line, and block buffering.
 205           -}
 206         let handle_' = handle_{ haType__ = SemiClosedHandle }
 207         case (haBufferMode__ handle_) of
 208          LineBuffering    -> do
 209             str <- unsafeInterleaveIO (lazyReadLine handle (haFO__ handle_))
 210             return (handle_', str)
 211          BlockBuffering _ -> do
 212             str <- unsafeInterleaveIO (lazyReadBlock handle (haFO__ handle_))
 213             return (handle_', str)
 214          NoBuffering      -> do
 215             str <- unsafeInterleaveIO (lazyReadChar handle (haFO__ handle_))
 216             return (handle_', str)
 217   where
 218    not_readable_error =
 219            IOError (Just handle) IllegalOperation "hGetContents"
 220                    ("handle is not open for reading")
 221 \end{code}
 222
 223 Note that someone may close the semi-closed handle (or change its buffering),
 224 so each these lazy read functions are pulled on, they have to check whether
 225 the handle has indeed been closed.
 226
 227 \begin{code}
 228 #ifndef __PARALLEL_HASKELL__
 229 lazyReadBlock :: Handle -> ForeignObj -> IO String
 230 lazyReadLine  :: Handle -> ForeignObj -> IO String
 231 lazyReadChar  :: Handle -> ForeignObj -> IO String
 232 #else
 233 lazyReadBlock :: Handle -> Addr -> IO String
 234 lazyReadLine  :: Handle -> Addr -> IO String
 235 lazyReadChar  :: Handle -> Addr -> IO String
 236 #endif
 237
 238 lazyReadBlock handle fo = do
 239    buf   <- getBufStart fo 0
 240    bytes <- mayBlock fo (readBlock fo) -- ConcHask: UNSAFE, may block.
 241    case (bytes::Int) of
 242      -3 -> -- buffering has been turned off, use lazyReadChar instead
 243            lazyReadChar handle fo
 244      -2 -> return ""
 245      -1 -> -- an error occurred, close the handle
 246           withHandle handle $ \ handle_ -> do
 247           closeFile (haFO__ handle_) 0{-don't bother flushing-}  -- ConcHask: SAFE, won't block.
 248           return (handle_ { haType__    = ClosedHandle,
 249                             haFO__      = nullFile__ },
 250                   "")
 251      _ -> do
 252       more <- unsafeInterleaveIO (lazyReadBlock handle fo)
 253       stToIO (unpackNBytesAccST buf bytes more)
 254
 255 lazyReadLine handle fo = do
 256      bytes <- mayBlock fo (readLine fo)   -- ConcHask: UNSAFE, may block.
 257      case (bytes::Int) of
 258        -3 -> -- buffering has been turned off, use lazyReadChar instead
 259              lazyReadChar handle fo
 260        -2 -> return "" -- handle closed by someone else, stop reading.
 261        -1 -> -- an error occurred, close the handle
 262              withHandle handle $ \ handle_ -> do
 263              closeFile (haFO__ handle_) 0{- don't bother flushing-}  -- ConcHask: SAFE, won't block
 264              return (handle_ { haType__    = ClosedHandle,
 265                                haFO__      = nullFile__ },
 266                      "")
 267        _ -> do
 268           more <- unsafeInterleaveIO (lazyReadLine handle fo)
 269           buf  <- getBufStart fo bytes  -- ConcHask: won't block
 270           stToIO (unpackNBytesAccST buf bytes more)
 271
 272 lazyReadChar handle fo = do
 273     char <- mayBlock fo (readChar fo)   -- ConcHask: UNSAFE, may block.
 274     case (char::Int) of
 275       -4 -> -- buffering is now block-buffered, use lazyReadBlock instead
 276             lazyReadBlock handle fo
 277
 278       -3 -> -- buffering is now line-buffered, use lazyReadLine instead
 279             lazyReadLine handle fo
 280       -2 -> return ""
 281       -1 -> -- error, silently close handle.
 282          withHandle handle $ \ handle_ -> do
 283          closeFile (haFO__ handle_) 0{-don't bother flusing-}  -- ConcHask: SAFE, won't block
 284          return (handle_{ haType__  = ClosedHandle,
 285                           haFO__    = nullFile__ },
 286                  "")
 287       _ -> do
 288          more <- unsafeInterleaveIO (lazyReadChar handle fo)
 289          return (chr char : more)
 290
 291 \end{code}
 292
 293
 294 %*********************************************************
 295 %*                                                      *
 296 \subsection{Simple output functions}
 297 %*                                                      *
 298 %*********************************************************
 299
 300 @hPutChar hdl ch@ writes the character @ch@ to the file
 301 or channel managed by @hdl@.  Characters may be buffered if
 302 buffering is enabled for @hdl@
 303
 304 \begin{code}
 305 hPutChar :: Handle -> Char -> IO ()
 306 hPutChar handle c =
 307     wantWriteableHandle "hPutChar" handle $ \ handle_  -> do
 308     let fo = haFO__ handle_
 309     flushConnectedBuf fo
 310     rc       <- mayBlock fo (filePutc fo c)   -- ConcHask: UNSAFE, may block.
 311     if rc == 0
 312      then return ()
 313      else constructErrorAndFail "hPutChar"
 314
 315 \end{code}
 316
 317 @hPutStr hdl s@ writes the string @s@ to the file or
 318 channel managed by @hdl@, buffering the output if needs be.
 319
 320 \begin{code}
 321 hPutStr :: Handle -> String -> IO ()
 322 hPutStr handle str =
 323     wantWriteableHandle "hPutStr" handle $ \ handle_ -> do
 324     let fo = haFO__ handle_
 325     flushConnectedBuf fo
 326     case haBufferMode__ handle_ of
 327        LineBuffering -> do
 328             buf <- getWriteableBuf fo
 329             pos <- getBufWPtr fo
 330             bsz <- getBufSize fo
 331             writeLines fo buf bsz pos str
 332        BlockBuffering _ -> do
 333             buf <- getWriteableBuf fo
 334             pos <- getBufWPtr fo
 335             bsz <- getBufSize fo
 336             writeBlocks fo buf bsz pos str
 337        NoBuffering -> do
 338             writeChars fo str
 339 \end{code}
 340
 341 Going across the border between Haskell and C is relatively costly,
 342 so for block writes we pack the character strings on the Haskell-side
 343 before passing the external write routine a pointer to the buffer.
 344
 345 \begin{code}
 346 #ifdef __HUGS__
 347
 348 #ifdef __CONCURRENT_HASKELL__
 349 /* See comment in shoveString below for explanation */
 350 #warning delayed update of buffer disnae work with killThread
 351 #endif
 352
 353 #ifndef __PARALLEL_HASKELL__
 354 writeLines :: ForeignObj -> Addr -> Int -> Int -> String -> IO ()
 355 #else
 356 writeLines :: Addr -> Addr -> Int -> Int -> String -> IO ()
 357 #endif
 358 writeLines obj buf bufLen initPos s =
 359   let
 360    shoveString :: Int -> [Char] -> IO ()
 361    shoveString n ls =
 362      case ls of
 363       [] ->
 364           {-
 365             At the end of a buffer write, update the buffer position
 366             in the underlying file object, so that if the handle
 367             is subsequently dropped by the program, the whole
 368             buffer will be properly flushed.
 369
 370             There's one case where this delayed up-date of the buffer
 371             position can go wrong: if a thread is killed, it might be
 372             in the middle of filling up a buffer, with the result that
 373             the partial buffer update is lost upon finalisation. Not
 374             that killing of threads is supported at the moment.
 375
 376           -}
 377           setBufWPtr obj n
 378
 379       (x:xs) -> do
 380         primWriteCharOffAddr buf n x
 381           {- Flushing on buffer exhaustion or newlines (even if it isn't the last one) -}
 382         if n == bufLen || x == '\n'
 383          then do
 384            rc <-  mayBlock obj (writeFileObject obj (n + 1))  -- ConcHask: UNSAFE, may block.
 385            if rc == 0
 386             then shoveString 0 xs
 387             else constructErrorAndFail "writeLines"
 388          else
 389            shoveString (n + 1) xs
 390   in
 391   shoveString initPos s
 392 #else /* ndef __HUGS__ */
 393 #ifndef __PARALLEL_HASKELL__
 394 writeLines :: ForeignObj -> Addr -> Int -> Int -> String -> IO ()
 395 #else
 396 writeLines :: Addr -> Addr -> Int -> Int -> String -> IO ()
 397 #endif
 398 writeLines obj buf (I# bufLen) (I# initPos#) s =
 399   let
 400    write_char :: Addr -> Int# -> Char# -> IO ()
 401    write_char (A# buf#) n# c# =
 402       IO $ \ s# ->
 403       case (writeCharOffAddr# buf# n# c# s#) of s2# -> (# s2#, () #)
 404
 405    shoveString :: Int# -> [Char] -> IO ()
 406    shoveString n ls =
 407      case ls of
 408       [] ->
 409           {-
 410             At the end of a buffer write, update the buffer position
 411             in the underlying file object, so that if the handle
 412             is subsequently dropped by the program, the whole
 413             buffer will be properly flushed.
 414
 415             There's one case where this delayed up-date of the buffer
 416             position can go wrong: if a thread is killed, it might be
 417             in the middle of filling up a buffer, with the result that
 418             the partial buffer update is lost upon finalisation. Not
 419             that killing of threads is supported at the moment.
 420
 421           -}
 422           setBufWPtr obj (I# n)
 423
 424       ((C# x):xs) -> do
 425         write_char buf n x
 426           {- Flushing on buffer exhaustion or newlines (even if it isn't the last one) -}
 427         if n ==# bufLen || x `eqChar#` '\n'#
 428          then do
 429            rc <-  mayBlock obj (writeFileObject obj (I# (n +# 1#)))  -- ConcHask: UNSAFE, may block.
 430            if rc == 0
 431             then shoveString 0# xs
 432             else constructErrorAndFail "writeLines"
 433          else
 434            shoveString (n +# 1#) xs
 435   in
 436   shoveString initPos# s
 437 #endif /* ndef __HUGS__ */
 438
 439 #ifdef __HUGS__
 440 #ifndef __PARALLEL_HASKELL__
 441 writeBlocks :: ForeignObj -> Addr -> Int -> Int -> String -> IO ()
 442 #else
 443 writeBlocks :: Addr -> Addr -> Int -> Int -> String -> IO ()
 444 #endif
 445 writeBlocks obj buf bufLen initPos s =
 446   let
 447    shoveString :: Int -> [Char] -> IO ()
 448    shoveString n ls =
 449      case ls of
 450       [] ->
 451           {-
 452             At the end of a buffer write, update the buffer position
 453             in the underlying file object, so that if the handle
 454             is subsequently dropped by the program, the whole
 455             buffer will be properly flushed.
 456
 457             There's one case where this delayed up-date of the buffer
 458             position can go wrong: if a thread is killed, it might be
 459             in the middle of filling up a buffer, with the result that
 460             the partial buffer update is lost upon finalisation. However,
 461             by the time killThread is supported, Haskell finalisers are also
 462             likely to be in, which means the 'IOFileObject' hack can go
 463             alltogether.
 464
 465           -}
 466           setBufWPtr obj n
 467
 468       (x:xs) -> do
 469         primWriteCharOffAddr buf n x
 470         if n == bufLen
 471          then do
 472            rc <-  mayBlock obj (writeFileObject obj (n + 1))   -- ConcHask: UNSAFE, may block.
 473            if rc == 0
 474             then shoveString 0 xs
 475             else constructErrorAndFail "writeChunks"
 476          else
 477            shoveString (n + 1) xs
 478   in
 479   shoveString initPos s
 480 #else /* ndef __HUGS__ */
 481 #ifndef __PARALLEL_HASKELL__
 482 writeBlocks :: ForeignObj -> Addr -> Int -> Int -> String -> IO ()
 483 #else
 484 writeBlocks :: Addr -> Addr -> Int -> Int -> String -> IO ()
 485 #endif
 486 writeBlocks obj buf (I# bufLen) (I# initPos#) s =
 487   let
 488    write_char :: Addr -> Int# -> Char# -> IO ()
 489    write_char (A# buf#) n# c# =
 490       IO $ \ s# ->
 491       case (writeCharOffAddr# buf# n# c# s#) of s2# -> (# s2#, () #)
 492
 493    shoveString :: Int# -> [Char] -> IO ()
 494    shoveString n ls =
 495      case ls of
 496       [] ->
 497           {-
 498             At the end of a buffer write, update the buffer position
 499             in the underlying file object, so that if the handle
 500             is subsequently dropped by the program, the whole
 501             buffer will be properly flushed.
 502
 503             There's one case where this delayed up-date of the buffer
 504             position can go wrong: if a thread is killed, it might be
 505             in the middle of filling up a buffer, with the result that
 506             the partial buffer update is lost upon finalisation. However,
 507             by the time killThread is supported, Haskell finalisers are also
 508             likely to be in, which means the 'IOFileObject' hack can go
 509             alltogether.
 510
 511           -}
 512           setBufWPtr obj (I# n)
 513
 514       ((C# x):xs) -> do
 515         write_char buf n x
 516         if n ==# bufLen
 517          then do
 518            rc <-  mayBlock obj (writeFileObject obj (I# (n +# 1#)))   -- ConcHask: UNSAFE, may block.
 519            if rc == 0
 520             then shoveString 0# xs
 521             else constructErrorAndFail "writeChunks"
 522          else
 523            shoveString (n +# 1#) xs
 524   in
 525   shoveString initPos# s
 526 #endif /* ndef __HUGS__ */
 527
 528 #ifndef __PARALLEL_HASKELL__
 529 writeChars :: ForeignObj -> String -> IO ()
 530 #else
 531 writeChars :: Addr -> String -> IO ()
 532 #endif
 533 writeChars _fo ""    = return ()
 534 writeChars fo (c:cs) = do
 535   rc <- mayBlock fo (filePutc fo c)   -- ConcHask: UNSAFE, may block.
 536   if rc == 0
 537    then writeChars fo cs
 538    else constructErrorAndFail "writeChars"
 539
 540 \end{code}
 541
 542 Computation @hPrint hdl t@ writes the string representation of {\em t}
 543 given by the @shows@ function to the file or channel managed by {\em
 544 hdl}.
 545
 546 [ Seem to have disappeared from the 1.4 interface  - SOF 2/97 ]
 547
 548 \begin{code}
 549 hPrint :: Show a => Handle -> a -> IO ()
 550 hPrint hdl = hPutStrLn hdl . show
 551 \end{code}
 552
 553 Derived action @hPutStrLn hdl str@ writes the string \tr{str} to
 554 the handle \tr{hdl}, adding a newline at the end.
 555
 556 \begin{code}
 557 hPutStrLn :: Handle -> String -> IO ()
 558 hPutStrLn hndl str = do
 559  hPutStr  hndl str
 560  hPutChar hndl '\n'
 561 \end{code}