move things out of GHC.HetMet.CodeTypes into GHC.HetMet.GuestLanguage

[ghc-base.git] / GHC / IO / Handle / FD.hs

diff --git a/GHC/IO/Handle/FD.hs b/GHC/IO/Handle/FD.hs
index deedb7f..cb16645 100644 (file)
--- a/GHC/IO/Handle/FD.hs
+++ b/GHC/IO/Handle/FD.hs
@@ -1,4 +1,5 @@
-{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, PatternGuards, ForeignFunctionInterface #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.IO.Handle.FD
@@ -15,14 +16,12 @@
 
 module GHC.IO.Handle.FD ( 
   stdin, stdout, stderr,
-  openFile, openBinaryFile,
+  openFile, openBinaryFile, openFileBlocking,
   mkHandleFromFD, fdToHandle, fdToHandle',
   isEOF
  ) where
 
 import GHC.Base
-import GHC.Num
-import GHC.Real
 import GHC.Show
 import Data.Maybe
 -- import Control.Monad
@@ -51,6 +50,7 @@ import qualified System.Posix.Internals as Posix
 
 -- | A handle managing input from the Haskell program's standard input channel.
 stdin :: Handle
+{-# NOINLINE stdin #-}
 stdin = unsafePerformIO $ do
    -- ToDo: acquire lock
    setBinaryMode FD.stdin
@@ -60,6 +60,7 @@ stdin = unsafePerformIO $ do
 
 -- | A handle managing output to the Haskell program's standard output channel.
 stdout :: Handle
+{-# NOINLINE stdout #-}
 stdout = unsafePerformIO $ do
    -- ToDo: acquire lock
    setBinaryMode FD.stdout
@@ -69,6 +70,7 @@ stdout = unsafePerformIO $ do
 
 -- | A handle managing output to the Haskell program's standard error channel.
 stderr :: Handle
+{-# NOINLINE stderr #-}
 stderr = unsafePerformIO $ do
     -- ToDo: acquire lock
    setBinaryMode FD.stderr
@@ -81,13 +83,17 @@ stdHandleFinalizer :: FilePath -> MVar Handle__ -> IO ()
 stdHandleFinalizer fp m = do
   h_ <- takeMVar m
   flushWriteBuffer h_
+  case haType h_ of 
+      ClosedHandle -> return ()
+      _other       -> closeTextCodecs h_
   putMVar m (ioe_finalizedHandle fp)
 
 -- We have to put the FDs into binary mode on Windows to avoid the newline
 -- translation that the CRT IO library does.
 setBinaryMode :: FD -> IO ()
 #ifdef mingw32_HOST_OS
-setBinaryMode fd = do setmode (fdFD fd) True; return ()
+setBinaryMode fd = do _ <- setmode (fdFD fd) True
+                      return ()
 #else
 setBinaryMode _ = return ()
 #endif
@@ -142,7 +148,17 @@ addFilePathToIOError fun fp ioe
 openFile :: FilePath -> IOMode -> IO Handle
 openFile fp im = 
   catchException
-    (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE)
+    (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE True)
+    (\e -> ioError (addFilePathToIOError "openFile" fp e))
+
+-- | Like 'openFile', but opens the file in ordinary blocking mode.
+-- This can be useful for opening a FIFO for reading: if we open in
+-- non-blocking mode then the open will fail if there are no writers,
+-- whereas a blocking open will block until a writer appears.
+openFileBlocking :: FilePath -> IOMode -> IO Handle
+openFileBlocking fp im =
+  catchException
+    (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE False)
     (\e -> ioError (addFilePathToIOError "openFile" fp e))
 
 -- | Like 'openFile', but open the file in binary mode.
@@ -157,18 +173,20 @@ openFile fp im =
 openBinaryFile :: FilePath -> IOMode -> IO Handle
 openBinaryFile fp m =
   catchException
-    (openFile' fp m True)
+    (openFile' fp m True True)
     (\e -> ioError (addFilePathToIOError "openBinaryFile" fp e))
 
-openFile' :: String -> IOMode -> Bool -> IO Handle
-openFile' filepath iomode binary = do
+openFile' :: String -> IOMode -> Bool -> Bool -> IO Handle
+openFile' filepath iomode binary non_blocking = do
   -- first open the file to get an FD
-  (fd, fd_type) <- FD.openFile filepath iomode
+  (fd, fd_type) <- FD.openFile filepath iomode non_blocking
 
   let mb_codec = if binary then Nothing else Just localeEncoding
 
   -- then use it to make a Handle
-  mkHandleFromFD fd fd_type filepath iomode True{-non-blocking-} mb_codec
+  mkHandleFromFD fd fd_type filepath iomode
+                   False {- do not *set* non-blocking mode -}
+                   mb_codec
             `onException` IODevice.close fd
         -- NB. don't forget to close the FD if mkHandleFromFD fails, otherwise
         -- this FD leaks.
@@ -183,9 +201,9 @@ openFile' filepath iomode binary = do
 mkHandleFromFD
    :: FD
    -> IODeviceType
-   -> FilePath -- a string describing this file descriptor (e.g. the filename)
+   -> FilePath  -- a string describing this file descriptor (e.g. the filename)
    -> IOMode
-   -> Bool -- non_blocking (*sets* non-blocking mode on the FD)
+   -> Bool      --  *set* non-blocking mode on the FD
    -> Maybe TextEncoding
    -> IO Handle
 
@@ -234,7 +252,7 @@ fdToHandle' fdint mb_type is_socket filepath iomode binary = do
                         Just RegularFile -> Nothing
                           -- no stat required for streams etc.:
                         Just other       -> Just (other,0,0)
-  (fd,fd_type) <- FD.mkFD (fromIntegral fdint) iomode mb_stat
+  (fd,fd_type) <- FD.mkFD fdint iomode mb_stat
                        is_socket
                        is_socket
   mkHandleFromFD fd fd_type filepath iomode is_socket
@@ -249,8 +267,8 @@ fdToHandle' fdint mb_type is_socket filepath iomode binary = do
 -- translation instead.
 fdToHandle :: Posix.FD -> IO Handle
 fdToHandle fdint = do
-   iomode <- Posix.fdGetMode (fromIntegral fdint)
-   (fd,fd_type) <- FD.mkFD (fromIntegral fdint) iomode Nothing
+   iomode <- Posix.fdGetMode fdint
+   (fd,fd_type) <- FD.mkFD fdint iomode Nothing
             False{-is_socket-} 
               -- NB. the is_socket flag is False, meaning that:
               --  on Windows we're guessing this is not a socket (XXX)