From 9fdbf0f92b42f8e64b1f6a4c2c60fe4595852b51 Mon Sep 17 00:00:00 2001 From: Don Stewart Date: Sat, 8 Mar 2008 01:20:59 +0000 Subject: [PATCH] untabify --- Control/Category.hs | 24 +++++----- Control/Monad/Instances.hs | 12 ++--- Foreign/C.hs | 4 +- Foreign/C/String.hs | 30 ++++++------ Foreign/Marshal/Array.hs | 8 ++-- Foreign/Marshal/Utils.hs | 34 +++++++------- Foreign/StablePtr.hs | 6 +-- System/IO/Error.hs | 70 ++++++++++++++-------------- System/IO/Unsafe.hs | 4 +- System/Posix/Internals.hs | 110 ++++++++++++++++++++++---------------------- System/Posix/Types.hs | 2 +- 11 files changed, 152 insertions(+), 152 deletions(-) diff --git a/Control/Category.hs b/Control/Category.hs index c85ebd5..770d850 100644 --- a/Control/Category.hs +++ b/Control/Category.hs @@ -21,26 +21,26 @@ infixr 1 >>>, <<< -- | A class for categories. -- id and (.) must form a monoid. class Category cat where - -- | the identity morphism - id :: cat a a + -- | the identity morphism + id :: cat a a - -- | morphism composition - (.) :: cat b c -> cat a b -> cat a c + -- | morphism composition + (.) :: cat b c -> cat a b -> cat a c {-# RULES -"identity/left" forall p . - id . p = p -"identity/right" forall p . - p . id = p -"association" forall p q r . - (p . q) . r = p . (q . r) +"identity/left" forall p . + id . p = p +"identity/right" forall p . + p . id = p +"association" forall p q r . + (p . q) . r = p . (q . r) #-} instance Category (->) where - id = Prelude.id + id = Prelude.id #ifndef __HADDOCK__ -- Haddock 1.x cannot parse this: - (.) = (Prelude..) + (.) = (Prelude..) #endif -- | Right-to-left composition diff --git a/Control/Monad/Instances.hs b/Control/Monad/Instances.hs index 1b0b2bf..63c943f 100644 --- a/Control/Monad/Instances.hs +++ b/Control/Monad/Instances.hs @@ -17,15 +17,15 @@ module Control.Monad.Instances (Functor(..),Monad(..)) where import Prelude instance Functor ((->) r) where - fmap = (.) + fmap = (.) instance Monad ((->) r) where - return = const - f >>= k = \ r -> k (f r) r + return = const + f >>= k = \ r -> k (f r) r instance Functor ((,) a) where - fmap f (x,y) = (x, f y) + fmap f (x,y) = (x, f y) instance Functor (Either a) where - fmap _ (Left x) = Left x - fmap f (Right y) = Right (f y) + fmap _ (Left x) = Left x + fmap f (Right y) = Right (f y) diff --git a/Foreign/C.hs b/Foreign/C.hs index 62dbaea..885ecf3 100644 --- a/Foreign/C.hs +++ b/Foreign/C.hs @@ -15,8 +15,8 @@ module Foreign.C ( module Foreign.C.Types - , module Foreign.C.String - , module Foreign.C.Error + , module Foreign.C.String + , module Foreign.C.Error ) where import Foreign.C.Types diff --git a/Foreign/C/String.hs b/Foreign/C/String.hs index 59e7d7b..df82aff 100644 --- a/Foreign/C/String.hs +++ b/Foreign/C/String.hs @@ -214,8 +214,8 @@ peekCAString cp = do where loop s i = do xval <- peekElemOff cp i - let val = castCCharToChar xval - val `seq` if i <= 0 then return (val:s) else loop (val:s) (i-1) + let val = castCCharToChar xval + val `seq` if i <= 0 then return (val:s) else loop (val:s) (i-1) #endif -- | Marshal a C string with explicit length into a Haskell string. @@ -232,11 +232,11 @@ peekCAStringLen (cp, len) where loop acc i = do xval <- peekElemOff cp i - let val = castCCharToChar xval - -- blow away the coercion ASAP. - if (val `seq` (i == 0)) - then return (val:acc) - else loop (val:acc) (i-1) + let val = castCCharToChar xval + -- blow away the coercion ASAP. + if (val `seq` (i == 0)) + then return (val:acc) + else loop (val:acc) (i-1) #endif -- | Marshal a Haskell string into a NUL terminated C string. @@ -254,8 +254,8 @@ newCAString = newArray0 nUL . charsToCChars newCAString str = do ptr <- mallocArray0 (length str) let - go [] n = pokeElemOff ptr n nUL - go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1) + go [] n = pokeElemOff ptr n nUL + go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1) go str 0 return ptr #endif @@ -276,8 +276,8 @@ newCAStringLen str = do newCAStringLen str = do ptr <- mallocArray0 len let - go [] n = n `seq` return () -- make it strict in n - go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1) + go [] n = n `seq` return () -- make it strict in n + go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1) go str 0 return (ptr, len) where @@ -300,8 +300,8 @@ withCAString = withArray0 nUL . charsToCChars withCAString str f = allocaArray0 (length str) $ \ptr -> let - go [] n = pokeElemOff ptr n nUL - go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1) + go [] n = pokeElemOff ptr n nUL + go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1) in do go str 0 f ptr @@ -321,8 +321,8 @@ withCAStringLen str act = withArray (charsToCChars str) $ act . pairLength str withCAStringLen str f = allocaArray len $ \ptr -> let - go [] n = n `seq` return () -- make it strict in n - go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1) + go [] n = n `seq` return () -- make it strict in n + go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1) in do go str 0 f (ptr,len) diff --git a/Foreign/Marshal/Array.hs b/Foreign/Marshal/Array.hs index b347b3a..ebd6f3c 100644 --- a/Foreign/Marshal/Array.hs +++ b/Foreign/Marshal/Array.hs @@ -63,8 +63,8 @@ module Foreign.Marshal.Array ( ) where import Control.Monad -import Foreign.Ptr (Ptr, plusPtr) -import Foreign.Storable (Storable(sizeOf,peekElemOff,pokeElemOff)) +import Foreign.Ptr (Ptr, plusPtr) +import Foreign.Storable (Storable(sizeOf,peekElemOff,pokeElemOff)) import Foreign.Marshal.Alloc (mallocBytes, allocaBytes, reallocBytes) import Foreign.Marshal.Utils (copyBytes, moveBytes) @@ -153,7 +153,7 @@ pokeArray ptr vals = zipWithM_ (pokeElemOff ptr) [0..] vals #else pokeArray ptr vals = go vals 0# where go [] n# = return () - go (val:vals) n# = do pokeElemOff ptr (I# n#) val; go vals (n# +# 1#) + go (val:vals) n# = do pokeElemOff ptr (I# n#) val; go vals (n# +# 1#) #endif -- |Write the list elements consecutive into memory and terminate them with the @@ -167,7 +167,7 @@ pokeArray0 marker ptr vals = do #else pokeArray0 marker ptr vals = go vals 0# where go [] n# = pokeElemOff ptr (I# n#) marker - go (val:vals) n# = do pokeElemOff ptr (I# n#) val; go vals (n# +# 1#) + go (val:vals) n# = do pokeElemOff ptr (I# n#) val; go vals (n# +# 1#) #endif diff --git a/Foreign/Marshal/Utils.hs b/Foreign/Marshal/Utils.hs index 72f7d9b..f3ffe50 100644 --- a/Foreign/Marshal/Utils.hs +++ b/Foreign/Marshal/Utils.hs @@ -24,16 +24,16 @@ module Foreign.Marshal.Utils ( -- ** Marshalling of Boolean values (non-zero corresponds to 'True') -- fromBool, -- :: Num a => Bool -> a - toBool, -- :: Num a => a -> Bool + toBool, -- :: Num a => a -> Bool -- ** Marshalling of Maybe values -- maybeNew, -- :: ( a -> IO (Ptr a)) - -- -> (Maybe a -> IO (Ptr a)) + -- -> (Maybe a -> IO (Ptr a)) maybeWith, -- :: ( a -> (Ptr b -> IO c) -> IO c) - -- -> (Maybe a -> (Ptr b -> IO c) -> IO c) + -- -> (Maybe a -> (Ptr b -> IO c) -> IO c) maybePeek, -- :: (Ptr a -> IO b ) - -- -> (Ptr a -> IO (Maybe b)) + -- -> (Ptr a -> IO (Maybe b)) -- ** Marshalling lists of storable objects -- @@ -47,20 +47,20 @@ module Foreign.Marshal.Utils ( ) where import Data.Maybe -import Foreign.Ptr ( Ptr, nullPtr ) -import Foreign.Storable ( Storable(poke) ) -import Foreign.C.Types ( CSize ) -import Foreign.Marshal.Alloc ( malloc, alloca ) +import Foreign.Ptr ( Ptr, nullPtr ) +import Foreign.Storable ( Storable(poke) ) +import Foreign.C.Types ( CSize ) +import Foreign.Marshal.Alloc ( malloc, alloca ) #ifdef __GLASGOW_HASKELL__ import GHC.IOBase -import GHC.Real ( fromIntegral ) +import GHC.Real ( fromIntegral ) import GHC.Num import GHC.Base #endif #ifdef __NHC__ -import Foreign.C.Types ( CInt(..) ) +import Foreign.C.Types ( CInt(..) ) #endif -- combined allocation and marshalling @@ -119,14 +119,14 @@ toBool = (/= 0) -- * the 'nullPtr' is used to represent 'Nothing' -- maybeNew :: ( a -> IO (Ptr a)) - -> (Maybe a -> IO (Ptr a)) + -> (Maybe a -> IO (Ptr a)) maybeNew = maybe (return nullPtr) -- |Converts a @withXXX@ combinator into one marshalling a value wrapped -- into a 'Maybe', using 'nullPtr' to represent 'Nothing'. -- maybeWith :: ( a -> (Ptr b -> IO c) -> IO c) - -> (Maybe a -> (Ptr b -> IO c) -> IO c) + -> (Maybe a -> (Ptr b -> IO c) -> IO c) maybeWith = maybe ($ nullPtr) -- |Convert a peek combinator into a one returning 'Nothing' if applied to a @@ -134,7 +134,7 @@ maybeWith = maybe ($ nullPtr) -- maybePeek :: (Ptr a -> IO b) -> Ptr a -> IO (Maybe b) maybePeek peek ptr | ptr == nullPtr = return Nothing - | otherwise = do a <- peek ptr; return (Just a) + | otherwise = do a <- peek ptr; return (Just a) -- marshalling lists of storable objects @@ -144,12 +144,12 @@ maybePeek peek ptr | ptr == nullPtr = return Nothing -- marshalled objects -- withMany :: (a -> (b -> res) -> res) -- withXXX combinator for one object - -> [a] -- storable objects - -> ([b] -> res) -- action on list of marshalled obj.s - -> res + -> [a] -- storable objects + -> ([b] -> res) -- action on list of marshalled obj.s + -> res withMany _ [] f = f [] withMany withFoo (x:xs) f = withFoo x $ \x' -> - withMany withFoo xs (\xs' -> f (x':xs')) + withMany withFoo xs (\xs' -> f (x':xs')) -- Haskellish interface to memcpy and memmove diff --git a/Foreign/StablePtr.hs b/Foreign/StablePtr.hs index 8ebdcfe..9ae1371 100644 --- a/Foreign/StablePtr.hs +++ b/Foreign/StablePtr.hs @@ -17,15 +17,15 @@ module Foreign.StablePtr ( -- * Stable references to Haskell values - StablePtr -- abstract + StablePtr -- abstract , newStablePtr -- :: a -> IO (StablePtr a) , deRefStablePtr -- :: StablePtr a -> IO a , freeStablePtr -- :: StablePtr a -> IO () , castStablePtrToPtr -- :: StablePtr a -> Ptr () , castPtrToStablePtr -- :: Ptr () -> StablePtr a - , -- ** The C-side interface + , -- ** The C-side interface - -- $cinterface + -- $cinterface ) where #ifdef __GLASGOW_HASKELL__ diff --git a/System/IO/Error.hs b/System/IO/Error.hs index 83dfd7e..c7827cb 100644 --- a/System/IO/Error.hs +++ b/System/IO/Error.hs @@ -17,20 +17,20 @@ module System.IO.Error ( -- * I\/O errors - IOError, -- = IOException + IOError, -- = IOException - userError, -- :: String -> IOError + userError, -- :: String -> IOError #ifndef __NHC__ - mkIOError, -- :: IOErrorType -> String -> Maybe Handle - -- -> Maybe FilePath -> IOError + mkIOError, -- :: IOErrorType -> String -> Maybe Handle + -- -> Maybe FilePath -> IOError - annotateIOError, -- :: IOError -> String -> Maybe Handle - -- -> Maybe FilePath -> IOError + annotateIOError, -- :: IOError -> String -> Maybe Handle + -- -> Maybe FilePath -> IOError #endif -- ** Classifying I\/O errors - isAlreadyExistsError, -- :: IOError -> Bool + isAlreadyExistsError, -- :: IOError -> Bool isDoesNotExistError, isAlreadyInUseError, isFullError, @@ -41,25 +41,25 @@ module System.IO.Error ( -- ** Attributes of I\/O errors #ifndef __NHC__ - ioeGetErrorType, -- :: IOError -> IOErrorType - ioeGetLocation, -- :: IOError -> String + ioeGetErrorType, -- :: IOError -> IOErrorType + ioeGetLocation, -- :: IOError -> String #endif - ioeGetErrorString, -- :: IOError -> String - ioeGetHandle, -- :: IOError -> Maybe Handle - ioeGetFileName, -- :: IOError -> Maybe FilePath + ioeGetErrorString, -- :: IOError -> String + ioeGetHandle, -- :: IOError -> Maybe Handle + ioeGetFileName, -- :: IOError -> Maybe FilePath #ifndef __NHC__ - ioeSetErrorType, -- :: IOError -> IOErrorType -> IOError - ioeSetErrorString, -- :: IOError -> String -> IOError - ioeSetLocation, -- :: IOError -> String -> IOError - ioeSetHandle, -- :: IOError -> Handle -> IOError - ioeSetFileName, -- :: IOError -> FilePath -> IOError + ioeSetErrorType, -- :: IOError -> IOErrorType -> IOError + ioeSetErrorString, -- :: IOError -> String -> IOError + ioeSetLocation, -- :: IOError -> String -> IOError + ioeSetHandle, -- :: IOError -> Handle -> IOError + ioeSetFileName, -- :: IOError -> FilePath -> IOError #endif -- * Types of I\/O error - IOErrorType, -- abstract + IOErrorType, -- abstract - alreadyExistsErrorType, -- :: IOErrorType + alreadyExistsErrorType, -- :: IOErrorType doesNotExistErrorType, alreadyInUseErrorType, fullErrorType, @@ -69,7 +69,7 @@ module System.IO.Error ( userErrorType, -- ** 'IOErrorType' predicates - isAlreadyExistsErrorType, -- :: IOErrorType -> Bool + isAlreadyExistsErrorType, -- :: IOErrorType -> Bool isDoesNotExistErrorType, isAlreadyInUseErrorType, isFullErrorType, @@ -80,13 +80,13 @@ module System.IO.Error ( -- * Throwing and catching I\/O errors - ioError, -- :: IOError -> IO a + ioError, -- :: IOError -> IO a - catch, -- :: IO a -> (IOError -> IO a) -> IO a - try, -- :: IO a -> IO (Either IOError a) + catch, -- :: IO a -> (IOError -> IO a) -> IO a + try, -- :: IO a -> IO (Either IOError a) #ifndef __NHC__ - modifyIOError, -- :: (IOError -> IOError) -> IO a -> IO a + modifyIOError, -- :: (IOError -> IOError) -> IO a -> IO a #endif ) where @@ -110,7 +110,7 @@ import IO , try , ioError , userError - , isAlreadyExistsError -- :: IOError -> Bool + , isAlreadyExistsError -- :: IOError -> Bool , isDoesNotExistError , isAlreadyInUseError , isFullError @@ -150,11 +150,11 @@ try f = catch (do r <- f mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> IOError mkIOError t location maybe_hdl maybe_filename = IOError{ ioe_type = t, - ioe_location = location, - ioe_description = "", - ioe_handle = maybe_hdl, - ioe_filename = maybe_filename - } + ioe_location = location, + ioe_description = "", + ioe_handle = maybe_hdl, + ioe_filename = maybe_filename + } #ifdef __NHC__ mkIOError EOF location maybe_hdl maybe_filename = EOFError location (fromJust maybe_hdl) @@ -228,8 +228,8 @@ isUserError = isUserErrorType . ioeGetErrorType #ifdef __NHC__ data IOErrorType = AlreadyExists | NoSuchThing | ResourceBusy - | ResourceExhausted | EOF | IllegalOperation - | PermissionDenied | UserError + | ResourceExhausted | EOF | IllegalOperation + | PermissionDenied | UserError #endif -- | I\/O error where the operation failed because one of its arguments @@ -266,8 +266,8 @@ permissionErrorType :: IOErrorType permissionErrorType = PermissionDenied -- | I\/O error that is programmer-defined. -userErrorType :: IOErrorType -userErrorType = UserError +userErrorType :: IOErrorType +userErrorType = UserError -- ----------------------------------------------------------------------------- -- IOErrorType predicates @@ -321,7 +321,7 @@ isUserErrorType _ = False -- Miscellaneous #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) -ioeGetErrorType :: IOError -> IOErrorType +ioeGetErrorType :: IOError -> IOErrorType ioeGetErrorString :: IOError -> String ioeGetLocation :: IOError -> String ioeGetHandle :: IOError -> Maybe Handle diff --git a/System/IO/Unsafe.hs b/System/IO/Unsafe.hs index 1ec5361..becd498 100644 --- a/System/IO/Unsafe.hs +++ b/System/IO/Unsafe.hs @@ -15,8 +15,8 @@ module System.IO.Unsafe ( -- * Unsafe 'System.IO.IO' operations - unsafePerformIO, -- :: IO a -> a - unsafeInterleaveIO, -- :: IO a -> IO a + unsafePerformIO, -- :: IO a -> a + unsafeInterleaveIO, -- :: IO a -> IO a ) where #ifdef __GLASGOW_HASKELL__ diff --git a/System/Posix/Internals.hs b/System/Posix/Internals.hs index 3039ea5..6eddda6 100644 --- a/System/Posix/Internals.hs +++ b/System/Posix/Internals.hs @@ -15,7 +15,7 @@ -- This library is built on *every* platform, including Win32. -- -- Non-posix compliant in order to support the following features: --- * S_ISSOCK (no sockets in POSIX) +-- * S_ISSOCK (no sockets in POSIX) -- ----------------------------------------------------------------------------- @@ -62,8 +62,8 @@ type CSigaction = () type CSigset = () type CStat = () type CTermios = () -type CTm = () -type CTms = () +type CTm = () +type CTms = () type CUtimbuf = () type CUtsname = () @@ -78,16 +78,16 @@ fdFileSize :: FD -> IO Integer fdFileSize fd = allocaBytes sizeof_stat $ \ p_stat -> do throwErrnoIfMinus1Retry "fileSize" $ - c_fstat fd p_stat + c_fstat fd p_stat c_mode <- st_mode p_stat :: IO CMode if not (s_isreg c_mode) - then return (-1) - else do + then return (-1) + else do c_size <- st_size p_stat return (fromIntegral c_size) data FDType = Directory | Stream | RegularFile | RawDevice - deriving (Eq) + deriving (Eq) fileType :: FilePath -> IO FDType fileType file = @@ -103,7 +103,7 @@ fdStat :: FD -> IO (FDType, CDev, CIno) fdStat fd = allocaBytes sizeof_stat $ \ p_stat -> do throwErrnoIfMinus1Retry "fdType" $ - c_fstat fd p_stat + c_fstat fd p_stat ty <- statGetType p_stat dev <- st_dev p_stat ino <- st_ino p_stat @@ -115,17 +115,17 @@ fdType fd = do (ty,_,_) <- fdStat fd; return ty statGetType p_stat = do c_mode <- st_mode p_stat :: IO CMode case () of - _ | s_isdir c_mode -> return Directory + _ | s_isdir c_mode -> return Directory | s_isfifo c_mode || s_issock c_mode || s_ischr c_mode - -> return Stream - | s_isreg c_mode -> return RegularFile - -- Q: map char devices to RawDevice too? - | s_isblk c_mode -> return RawDevice - | otherwise -> ioError ioe_unknownfiletype + -> return Stream + | s_isreg c_mode -> return RegularFile + -- Q: map char devices to RawDevice too? + | s_isblk c_mode -> return RawDevice + | otherwise -> ioError ioe_unknownfiletype ioe_unknownfiletype = IOError Nothing UnsupportedOperation "fdType" - "unknown file type" Nothing + "unknown file type" Nothing #if __GLASGOW_HASKELL__ && (defined(mingw32_HOST_OS) || defined(__MINGW32__)) closeFd :: Bool -> CInt -> IO CInt @@ -145,7 +145,7 @@ fdGetMode fd = do let flags = o_RDWR #else flags <- throwErrnoIfMinus1Retry "fdGetMode" - (c_fcntl_read fd const_f_getfl) + (c_fcntl_read fd const_f_getfl) #endif let wH = (flags .&. o_WRONLY) /= 0 @@ -153,11 +153,11 @@ fdGetMode fd = do rwH = (flags .&. o_RDWR) /= 0 mode - | wH && aH = AppendMode - | wH = WriteMode - | rwH = ReadWriteMode - | otherwise = ReadMode - + | wH && aH = AppendMode + | wH = WriteMode + | rwH = ReadWriteMode + | otherwise = ReadMode + return mode -- --------------------------------------------------------------------------- @@ -173,8 +173,8 @@ setEcho fd on = do tcSetAttr fd $ \ p_tios -> do c_lflag <- c_lflag p_tios :: IO CTcflag let new_c_lflag - | on = c_lflag .|. fromIntegral const_echo - | otherwise = c_lflag .&. complement (fromIntegral const_echo) + | on = c_lflag .|. fromIntegral const_echo + | otherwise = c_lflag .&. complement (fromIntegral const_echo) poke_c_lflag p_tios (new_c_lflag :: CTcflag) getEcho :: FD -> IO Bool @@ -190,49 +190,49 @@ setCooked fd cooked = -- turn on/off ICANON c_lflag <- c_lflag p_tios :: IO CTcflag let new_c_lflag | cooked = c_lflag .|. (fromIntegral const_icanon) - | otherwise = c_lflag .&. complement (fromIntegral const_icanon) + | otherwise = c_lflag .&. complement (fromIntegral const_icanon) poke_c_lflag p_tios (new_c_lflag :: CTcflag) -- set VMIN & VTIME to 1/0 respectively when (not cooked) $ do c_cc <- ptr_c_cc p_tios - let vmin = (c_cc `plusPtr` (fromIntegral const_vmin)) :: Ptr Word8 - vtime = (c_cc `plusPtr` (fromIntegral const_vtime)) :: Ptr Word8 - poke vmin 1 - poke vtime 0 + let vmin = (c_cc `plusPtr` (fromIntegral const_vmin)) :: Ptr Word8 + vtime = (c_cc `plusPtr` (fromIntegral const_vtime)) :: Ptr Word8 + poke vmin 1 + poke vtime 0 tcSetAttr :: FD -> (Ptr CTermios -> IO a) -> IO a tcSetAttr fd fun = do allocaBytes sizeof_termios $ \p_tios -> do - throwErrnoIfMinus1Retry "tcSetAttr" - (c_tcgetattr fd p_tios) + throwErrnoIfMinus1Retry "tcSetAttr" + (c_tcgetattr fd p_tios) #ifdef __GLASGOW_HASKELL__ - -- Save a copy of termios, if this is a standard file descriptor. - -- These terminal settings are restored in hs_exit(). - when (fd <= 2) $ do - p <- get_saved_termios fd - when (p == nullPtr) $ do - saved_tios <- mallocBytes sizeof_termios - copyBytes saved_tios p_tios sizeof_termios - set_saved_termios fd saved_tios + -- Save a copy of termios, if this is a standard file descriptor. + -- These terminal settings are restored in hs_exit(). + when (fd <= 2) $ do + p <- get_saved_termios fd + when (p == nullPtr) $ do + saved_tios <- mallocBytes sizeof_termios + copyBytes saved_tios p_tios sizeof_termios + set_saved_termios fd saved_tios #endif - -- tcsetattr() when invoked by a background process causes the process - -- to be sent SIGTTOU regardless of whether the process has TOSTOP set - -- in its terminal flags (try it...). This function provides a - -- wrapper which temporarily blocks SIGTTOU around the call, making it - -- 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 - 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 - return r + -- tcsetattr() when invoked by a background process causes the process + -- to be sent SIGTTOU regardless of whether the process has TOSTOP set + -- in its terminal flags (try it...). This function provides a + -- wrapper which temporarily blocks SIGTTOU around the call, making it + -- 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 + 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 + return r #ifdef __GLASGOW_HASKELL__ foreign import ccall unsafe "HsBase.h __hscore_get_saved_termios" @@ -296,7 +296,7 @@ foreign import ccall unsafe "consUtils.h get_console_echo__" setNonBlockingFD fd = do flags <- throwErrnoIfMinus1Retry "setNonBlockingFD" - (c_fcntl_read fd const_f_getfl) + (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. @@ -371,7 +371,7 @@ foreign import ccall unsafe "HsBase.h read" foreign import ccall unsafe "dirUtils.h __hscore_renameFile" c_rename :: CString -> CString -> IO CInt - + foreign import ccall unsafe "HsBase.h rewinddir" c_rewinddir :: Ptr CDir -> IO () diff --git a/System/Posix/Types.hs b/System/Posix/Types.hs index 54fa8b8..0f41050 100644 --- a/System/Posix/Types.hs +++ b/System/Posix/Types.hs @@ -197,5 +197,5 @@ type FileMode = CMode type ProcessID = CPid type FileOffset = COff type ProcessGroupID = CPid -type Limit = CLong +type Limit = CLong -- 1.7.10.4