Use explicit language extensions & remove extension fields from base.cabal

[ghc-base.git] / System / Posix / Internals.hs

diff --git a/System/Posix/Internals.hs b/System/Posix/Internals.hs
index 8916059..2a6126c 100644 (file)
--- a/System/Posix/Internals.hs
+++ b/System/Posix/Internals.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, ForeignFunctionInterface #-}
 {-# OPTIONS_GHC -fno-warn-unused-binds #-}
 {-# OPTIONS_HADDOCK hide #-}
 
@@ -37,7 +37,7 @@ import System.Posix.Types
 import Foreign
 import Foreign.C
 
-import Data.Bits
+-- import Data.Bits
 import Data.Maybe
 
 #if !defined(HTYPE_TCFLAG_T)
@@ -63,14 +63,12 @@ import DIOError
 #endif
 
 #ifdef __HUGS__
-{-# CFILES cbits/PrelIOUtils.c cbits/dirUtils.c cbits/consUtils.c #-}
+{-# CFILES cbits/PrelIOUtils.c cbits/consUtils.c #-}
 #endif
 
 -- ---------------------------------------------------------------------------
 -- Types
 
-type CDir       = ()
-type CDirent    = ()
 type CFLock     = ()
 type CGroup     = ()
 type CLconv     = ()
@@ -92,7 +90,7 @@ type FD = CInt
 fdFileSize :: FD -> IO Integer
 fdFileSize fd = 
   allocaBytes sizeof_stat $ \ p_stat -> do
-    throwErrnoIfMinus1Retry "fileSize" $
+    throwErrnoIfMinus1Retry_ "fileSize" $
         c_fstat fd p_stat
     c_mode <- st_mode p_stat :: IO CMode 
     if not (s_isreg c_mode)
@@ -105,7 +103,7 @@ fileType :: FilePath -> IO IODeviceType
 fileType file =
   allocaBytes sizeof_stat $ \ p_stat -> do
   withFilePath file $ \p_file -> do
-    throwErrnoIfMinus1Retry "fileType" $
+    throwErrnoIfMinus1Retry_ "fileType" $
       c_stat p_file p_stat
     statGetType p_stat
 
@@ -114,7 +112,7 @@ fileType file =
 fdStat :: FD -> IO (IODeviceType, CDev, CIno)
 fdStat fd = 
   allocaBytes sizeof_stat $ \ p_stat -> do
-    throwErrnoIfMinus1Retry "fdType" $
+    throwErrnoIfMinus1Retry_ "fdType" $
         c_fstat fd p_stat
     ty <- statGetType p_stat
     dev <- st_dev p_stat
@@ -221,7 +219,7 @@ setCooked fd cooked =
 tcSetAttr :: FD -> (Ptr CTermios -> IO a) -> IO a
 tcSetAttr fd fun = do
      allocaBytes sizeof_termios  $ \p_tios -> do
-        throwErrnoIfMinus1Retry "tcSetAttr"
+        throwErrnoIfMinus1Retry_ "tcSetAttr"
            (c_tcgetattr fd p_tios)
 
 #ifdef __GLASGOW_HASKELL__
@@ -242,13 +240,17 @@ tcSetAttr fd fun = do
         -- transparent.
         allocaBytes sizeof_sigset_t $ \ p_sigset -> do
           allocaBytes sizeof_sigset_t $ \ p_old_sigset -> do
-             c_sigemptyset p_sigset
-             c_sigaddset   p_sigset const_sigttou
-             c_sigprocmask const_sig_block p_sigset p_old_sigset
+             throwErrnoIfMinus1_ "sigemptyset" $
+                 c_sigemptyset p_sigset
+             throwErrnoIfMinus1_ "sigaddset" $
+                 c_sigaddset   p_sigset const_sigttou
+             throwErrnoIfMinus1_ "sigprocmask" $
+                 c_sigprocmask const_sig_block p_sigset p_old_sigset
              r <- fun p_tios  -- do the business
              throwErrnoIfMinus1Retry_ "tcSetAttr" $
                  c_tcsetattr fd const_tcsanow p_tios
-             c_sigprocmask const_sig_setmask p_old_sigset nullPtr
+             throwErrnoIfMinus1_ "sigprocmask" $
+                 c_sigprocmask const_sig_setmask p_old_sigset nullPtr
              return r
 
 #ifdef __GLASGOW_HASKELL__
@@ -309,26 +311,31 @@ foreign import ccall unsafe "consUtils.h set_console_echo__"
 foreign import ccall unsafe "consUtils.h get_console_echo__"
    get_console_echo :: CInt -> IO CInt
 
+foreign import ccall unsafe "consUtils.h is_console__"
+   is_console :: CInt -> IO CInt
+
 #endif
 
 -- ---------------------------------------------------------------------------
 -- Turning on non-blocking for a file descriptor
 
-setNonBlockingFD :: FD -> IO ()
+setNonBlockingFD :: FD -> Bool -> IO ()
 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
-setNonBlockingFD fd = do
+setNonBlockingFD fd set = do
   flags <- throwErrnoIfMinus1Retry "setNonBlockingFD"
                  (c_fcntl_read fd const_f_getfl)
-  -- An error when setting O_NONBLOCK isn't fatal: on some systems 
-  -- there are certain file handles on which this will fail (eg. /dev/null
-  -- on FreeBSD) so we throw away the return code from fcntl_write.
-  unless (testBit flags (fromIntegral o_NONBLOCK)) $ do
-    c_fcntl_write fd const_f_setfl (fromIntegral (flags .|. o_NONBLOCK))
+  let flags' | set       = flags .|. o_NONBLOCK
+             | otherwise = flags .&. complement o_NONBLOCK
+  unless (flags == flags') $ do
+    -- An error when setting O_NONBLOCK isn't fatal: on some systems
+    -- there are certain file handles on which this will fail (eg. /dev/null
+    -- on FreeBSD) so we throw away the return code from fcntl_write.
+    _ <- c_fcntl_write fd const_f_setfl (fromIntegral flags')
     return ()
 #else
 
 -- bogus defns for win32
-setNonBlockingFD _ = return ()
+setNonBlockingFD _ _ = return ()
 
 #endif
 
@@ -338,9 +345,8 @@ setNonBlockingFD _ = return ()
 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
 setCloseOnExec :: FD -> IO ()
 setCloseOnExec fd = do
-  throwErrnoIfMinus1 "setCloseOnExec" $
+  throwErrnoIfMinus1_ "setCloseOnExec" $
     c_fcntl_write fd const_f_setfd const_fd_cloexec
-  return ()
 #endif
 
 -- -----------------------------------------------------------------------------
@@ -361,9 +367,6 @@ foreign import ccall unsafe "HsBase.h chmod"
 foreign import ccall unsafe "HsBase.h close"
    c_close :: CInt -> IO CInt
 
-foreign import ccall unsafe "HsBase.h closedir" 
-   c_closedir :: Ptr CDir -> IO CInt
-
 foreign import ccall unsafe "HsBase.h creat"
    c_creat :: CString -> CMode -> IO CInt
 
@@ -390,25 +393,16 @@ foreign import ccall unsafe "HsBase.h __hscore_lseek"
 foreign import ccall unsafe "HsBase.h __hscore_lstat"
    lstat :: CFilePath -> Ptr CStat -> IO CInt
 
-foreign import ccall unsafe "__hscore_open"
+foreign import ccall unsafe "HsBase.h __hscore_open"
    c_open :: CFilePath -> CInt -> CMode -> IO CInt
 
-foreign import ccall unsafe "HsBase.h opendir" 
-   c_opendir :: CString  -> IO (Ptr CDir)
-
-foreign import ccall unsafe "HsBase.h __hscore_mkdir"
-   mkdir :: CString -> CInt -> IO CInt
-
 foreign import ccall unsafe "HsBase.h read" 
    c_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize
 
-foreign import ccall safe "read"
+foreign import ccall safe "HsBase.h read"
    c_safe_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize
 
-foreign import ccall unsafe "HsBase.h rewinddir"
-   c_rewinddir :: Ptr CDir -> IO ()
-
-foreign import ccall unsafe "__hscore_stat"
+foreign import ccall unsafe "HsBase.h __hscore_stat"
    c_stat :: CFilePath -> Ptr CStat -> IO CInt
 
 foreign import ccall unsafe "HsBase.h umask"
@@ -417,7 +411,7 @@ foreign import ccall unsafe "HsBase.h umask"
 foreign import ccall unsafe "HsBase.h write" 
    c_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize
 
-foreign import ccall safe "write"
+foreign import ccall safe "HsBase.h write"
    c_safe_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize
 
 foreign import ccall unsafe "HsBase.h __hscore_ftruncate"
@@ -466,26 +460,13 @@ foreign import ccall unsafe "HsBase.h tcgetattr"
 foreign import ccall unsafe "HsBase.h tcsetattr"
    c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt
 
-foreign import ccall unsafe "HsBase.h utime"
+foreign import ccall unsafe "HsBase.h __hscore_utime"
    c_utime :: CString -> Ptr CUtimbuf -> IO CInt
 
 foreign import ccall unsafe "HsBase.h waitpid"
    c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid
 #endif
 
--- traversing directories
-foreign import ccall unsafe "dirUtils.h __hscore_readdir"
-  readdir  :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
- 
-foreign import ccall unsafe "HsBase.h __hscore_free_dirent"
-  freeDirEnt  :: Ptr CDirent -> IO ()
- 
-foreign import ccall unsafe "HsBase.h __hscore_end_of_dir"
-  end_of_dir :: CInt
- 
-foreign import ccall unsafe "HsBase.h __hscore_d_name"
-  d_name :: Ptr CDirent -> IO CString
-
 -- POSIX flags only:
 foreign import ccall unsafe "HsBase.h __hscore_o_rdonly" o_RDONLY :: CInt
 foreign import ccall unsafe "HsBase.h __hscore_o_wronly" o_WRONLY :: CInt