Wolfgang Jeltsch pushed to branch wip/jeltsch/obtaining-os-handles at Glasgow Haskell Compiler / GHC Commits: c4a0d504 by Wolfgang Jeltsch at 2025-12-12T21:26:15+02:00 Move the `System.IO.OS` implementation into `ghc-internal` - - - - - 3 changed files: - libraries/base/src/System/IO/OS.hs - libraries/ghc-internal/ghc-internal.cabal.in - + libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs Changes: ===================================== libraries/base/src/System/IO/OS.hs ===================================== @@ -1,6 +1,4 @@ {-# LANGUAGE Safe #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE RankNTypes #-} {-| This module bridges between Haskell handles and underlying operating-system @@ -23,295 +21,17 @@ module System.IO.OS ) where -import GHC.Internal.Control.Monad (return) -import GHC.Internal.Control.Concurrent.MVar (MVar) -import GHC.Internal.Control.Exception (mask) -import GHC.Internal.Data.Function (const, (.), ($)) -import GHC.Internal.Data.Functor (fmap) -#if defined(mingw32_HOST_OS) -import GHC.Internal.Data.Bool (otherwise) -#endif -import GHC.Internal.Data.Maybe (Maybe (Nothing), maybe) -#if defined(mingw32_HOST_OS) -import GHC.Internal.Data.Maybe (Maybe (Just)) -#endif -import GHC.Internal.Data.List ((++)) -import GHC.Internal.Data.String (String) -import GHC.Internal.Data.Typeable (Typeable, cast) -import GHC.Internal.System.IO (IO) -import GHC.Internal.IO.FD (fdFD) -#if defined(mingw32_HOST_OS) -import GHC.Internal.IO.Windows.Handle +import GHC.Internal.System.IO.OS ( - NativeHandle, - ConsoleHandle, - IoHandle, - toHANDLE + withFileDescriptorReadingBiased, + withFileDescriptorWritingBiased, + withWindowsHandleReadingBiased, + withWindowsHandleWritingBiased, + withFileDescriptorReadingBiasedRaw, + withFileDescriptorWritingBiasedRaw, + withWindowsHandleReadingBiasedRaw, + withWindowsHandleWritingBiasedRaw ) -#endif -import GHC.Internal.IO.Handle.Types - ( - Handle (FileHandle, DuplexHandle), - Handle__ (Handle__, haDevice) - ) -import GHC.Internal.IO.Handle.Internals (withHandle_', flushBuffer) -import GHC.Internal.IO.Exception - ( - IOErrorType (InappropriateType), - IOException (IOError), - ioException - ) -import GHC.Internal.Foreign.Ptr (Ptr) -import GHC.Internal.Foreign.C.Types (CInt) - --- * Obtaining POSIX file descriptors and Windows handles - -{-| - Executes a user-provided action on an operating-system handle that underlies - a Haskell handle. Before the user-provided action is run, user-defined - perparation based on the handle state that contains the operating-system - handle is performed. While the user-provided action is executed, further - operations on the Haskell handle are blocked to a degree that interference - with this action is prevented. - - See [below](#with-ref-caveats) for caveats regarding this operation. --} -withOSHandle :: String - -- ^ The name of the overall operation - -> (Handle -> MVar Handle__) - {-^ - Obtaining of the handle state variable that holds the - operating-system handle - -} - -> (forall d. Typeable d => d -> IO a) - -- ^ Conversion of a device into an operating-system handle - -> (Handle__ -> IO ()) - -- ^ The preparation - -> Handle - -- ^ The Haskell handle to use - -> (a -> IO r) - -- ^ The action to execute on the operating-system handle - -> IO r -withOSHandle opName handleStateVar getOSHandle prepare handle act - = mask $ \ withOriginalMaskingState -> - withHandleState $ \ handleState@Handle__ {haDevice = dev} -> do - osHandle <- getOSHandle dev - prepare handleState - withOriginalMaskingState $ act osHandle - where - - withHandleState = withHandle_' opName handle (handleStateVar handle) -{- - The 'withHandle_'' operation, which we use here, already performs masking. - Still, we have to employ 'mask', in order do obtain the operation that - restores the original masking state. The user-provided action should be - executed with this original masking state, as there is no inherent reason to - generally perform it with masking in place. The masking that 'withHandle_'' - performs is only for safely accessing handle state and thus constitutes an - implementation detail; it has nothing to do with the user-provided action. --} -{- - The order of actions in 'withOSHandle' is such that any exception from - 'getOSHandle' is thrown before the flushing of the Haskell-managed buffers. --} - -{-| - Obtains the handle state variable that underlies a handle or specifically - the handle state variable for reading if the handle uses different state - variables for reading and writing. --} -handleStateVarReadingBiased :: Handle -> MVar Handle__ -handleStateVarReadingBiased (FileHandle _ var) = var -handleStateVarReadingBiased (DuplexHandle _ readingVar _) = readingVar - -{-| - Obtains the handle state variable that underlies a handle or specifically - the handle state variable for writing if the handle uses different state - variables for reading and writing. --} -handleStateVarWritingBiased :: Handle -> MVar Handle__ -handleStateVarWritingBiased (FileHandle _ var) = var -handleStateVarWritingBiased (DuplexHandle _ _ writingVar) = writingVar - -{-| - Yields the result of another operation if that operation succeeded, and - otherwise throws an exception that signals that the other operation failed - because some Haskell handle does not use an operating-system handle of a - required type. --} -requiringOSHandleOfType :: String - -- ^ The name of the operating-system handle type - -> Maybe a - {-^ - The result of the other operation if it succeeded - -} - -> IO a -requiringOSHandleOfType osHandleTypeName - = maybe (ioException osHandleOfTypeRequired) return - where - - osHandleOfTypeRequired :: IOException - osHandleOfTypeRequired - = IOError Nothing - InappropriateType - "" - ("handle does not use " ++ osHandleTypeName ++ "s") - Nothing - Nothing - -{-| - Obtains the POSIX file descriptor of a device if the device contains one, - and throws an exception otherwise. --} -getFileDescriptor :: Typeable d => d -> IO CInt -getFileDescriptor = requiringOSHandleOfType "POSIX file descriptor" . - fmap fdFD . cast - -{-| - Obtains the Windows handle of a device if the device contains one, and - throws an exception otherwise. --} -getWindowsHandle :: Typeable d => d -> IO (Ptr ()) -getWindowsHandle = requiringOSHandleOfType "Windows handle" . - toMaybeWindowsHandle - where - - toMaybeWindowsHandle :: Typeable d => d -> Maybe (Ptr ()) -#if defined(mingw32_HOST_OS) - toMaybeWindowsHandle dev - | Just nativeHandle <- cast dev :: Maybe (IoHandle NativeHandle) - = Just (toHANDLE nativeHandle) - | Just consoleHandle <- cast dev :: Maybe (IoHandle ConsoleHandle) - = Just (toHANDLE consoleHandle) - | otherwise - = Nothing - {- - This is inspired by the implementation of - 'System.Win32.Types.withHandleToHANDLENative'. - -} -#else - toMaybeWindowsHandle _ = Nothing -#endif - -{-| - Executes a user-provided action on the POSIX file descriptor that underlies - a handle or specifically on the POSIX file descriptor for reading if the - handle uses different file descriptors for reading and writing. The - Haskell-managed buffers related to the file descriptor are flushed before - the user-provided action is run. While this action is executed, further - operations on the handle are blocked to a degree that interference with this - action is prevented. - - If the handle does not use POSIX file descriptors, an exception is thrown. - - See [below](#with-ref-caveats) for caveats regarding this operation. --} -withFileDescriptorReadingBiased :: Handle -> (CInt -> IO r) -> IO r -withFileDescriptorReadingBiased = withOSHandle "withFileDescriptorReadingBiased" - handleStateVarReadingBiased - getFileDescriptor - flushBuffer - -{-| - Executes a user-provided action on the POSIX file descriptor that underlies - a handle or specifically on the POSIX file descriptor for writing if the - handle uses different file descriptors for reading and writing. The - Haskell-managed buffers related to the file descriptor are flushed before - the user-provided action is run. While this action is executed, further - operations on the handle are blocked to a degree that interference with this - action is prevented. - - If the handle does not use POSIX file descriptors, an exception is thrown. - - See [below](#with-ref-caveats) for caveats regarding this operation. --} -withFileDescriptorWritingBiased :: Handle -> (CInt -> IO r) -> IO r -withFileDescriptorWritingBiased = withOSHandle "withFileDescriptorWritingBiased" - handleStateVarWritingBiased - getFileDescriptor - flushBuffer - -{-| - Executes a user-provided action on the Windows handle that underlies a - Haskell handle or specifically on the Windows handle for reading if the - Haskell handle uses different Windows handles for reading and writing. The - Haskell-managed buffers related to the Windows handle are flushed before the - user-provided action is run. While this action is executed, further - operations on the Haskell handle are blocked to a degree that interference - with this action is prevented. - - If the Haskell handle does not use Windows handles, an exception is thrown. - - See [below](#with-ref-caveats) for caveats regarding this operation. --} -withWindowsHandleReadingBiased :: Handle -> (Ptr () -> IO r) -> IO r -withWindowsHandleReadingBiased = withOSHandle "withWindowsHandleReadingBiased" - handleStateVarReadingBiased - getWindowsHandle - flushBuffer - -{-| - Executes a user-provided action on the Windows handle that underlies a - Haskell handle or specifically on the Windows handle for writing if the - Haskell handle uses different Windows handles for reading and writing. The - Haskell-managed buffers related to the Windows handle are flushed before the - user-provided action is run. While this action is executed, further - operations on the Haskell handle are blocked to a degree that interference - with this action is prevented. - - If the Haskell handle does not use Windows handles, an exception is thrown. - - See [below](#with-ref-caveats) for caveats regarding this operation. --} -withWindowsHandleWritingBiased :: Handle -> (Ptr () -> IO r) -> IO r -withWindowsHandleWritingBiased = withOSHandle "withWindowsHandleWritingBiased" - handleStateVarWritingBiased - getWindowsHandle - flushBuffer - -{-| - Like 'withFileDescriptorReadingBiased' except that Haskell-managed buffers - are not flushed. --} -withFileDescriptorReadingBiasedRaw :: Handle -> (CInt -> IO r) -> IO r -withFileDescriptorReadingBiasedRaw - = withOSHandle "withFileDescriptorReadingBiasedRaw" - handleStateVarReadingBiased - getFileDescriptor - (const $ return ()) - -{-| - Like 'withFileDescriptorWritingBiased' except that Haskell-managed buffers - are not flushed. --} -withFileDescriptorWritingBiasedRaw :: Handle -> (CInt -> IO r) -> IO r -withFileDescriptorWritingBiasedRaw - = withOSHandle "withFileDescriptorWritingBiasedRaw" - handleStateVarWritingBiased - getFileDescriptor - (const $ return ()) - -{-| - Like 'withWindowsHandleReadingBiased' except that Haskell-managed buffers - are not flushed. --} -withWindowsHandleReadingBiasedRaw :: Handle -> (Ptr () -> IO r) -> IO r -withWindowsHandleReadingBiasedRaw - = withOSHandle "withWindowsHandleReadingBiasedRaw" - handleStateVarReadingBiased - getWindowsHandle - (const $ return ()) - -{-| - Like 'withWindowsHandleWritingBiased' except that Haskell-managed buffers - are not flushed. --} -withWindowsHandleWritingBiasedRaw :: Handle -> (Ptr () -> IO r) -> IO r -withWindowsHandleWritingBiasedRaw - = withOSHandle "withWindowsHandleWritingBiasedRaw" - handleStateVarWritingBiased - getWindowsHandle - (const $ return ()) -- ** Caveats ===================================== libraries/ghc-internal/ghc-internal.cabal.in ===================================== @@ -327,6 +327,7 @@ Library GHC.Internal.System.Exit GHC.Internal.System.IO GHC.Internal.System.IO.Error + GHC.Internal.System.IO.OS GHC.Internal.System.Mem GHC.Internal.System.Mem.StableName GHC.Internal.System.Posix.Internals ===================================== libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs ===================================== @@ -0,0 +1,342 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE RankNTypes #-} + +{-| + This module bridges between Haskell handles and underlying operating-system + features. +-} +module GHC.Internal.System.IO.OS +( + -- * Obtaining file descriptors and Windows handles + withFileDescriptorReadingBiased, + withFileDescriptorWritingBiased, + withWindowsHandleReadingBiased, + withWindowsHandleWritingBiased, + withFileDescriptorReadingBiasedRaw, + withFileDescriptorWritingBiasedRaw, + withWindowsHandleReadingBiasedRaw, + withWindowsHandleWritingBiasedRaw + + -- ** Caveats + -- $with-ref-caveats +) +where + +import GHC.Internal.Control.Monad (return) +import GHC.Internal.Control.Concurrent.MVar (MVar) +import GHC.Internal.Control.Exception (mask) +import GHC.Internal.Data.Function (const, (.), ($)) +import GHC.Internal.Data.Functor (fmap) +#if defined(mingw32_HOST_OS) +import GHC.Internal.Data.Bool (otherwise) +#endif +import GHC.Internal.Data.Maybe (Maybe (Nothing), maybe) +#if defined(mingw32_HOST_OS) +import GHC.Internal.Data.Maybe (Maybe (Just)) +#endif +import GHC.Internal.Data.List ((++)) +import GHC.Internal.Data.String (String) +import GHC.Internal.Data.Typeable (Typeable, cast) +import GHC.Internal.System.IO (IO) +import GHC.Internal.IO.FD (fdFD) +#if defined(mingw32_HOST_OS) +import GHC.Internal.IO.Windows.Handle + ( + NativeHandle, + ConsoleHandle, + IoHandle, + toHANDLE + ) +#endif +import GHC.Internal.IO.Handle.Types + ( + Handle (FileHandle, DuplexHandle), + Handle__ (Handle__, haDevice) + ) +import GHC.Internal.IO.Handle.Internals (withHandle_', flushBuffer) +import GHC.Internal.IO.Exception + ( + IOErrorType (InappropriateType), + IOException (IOError), + ioException + ) +import GHC.Internal.Foreign.Ptr (Ptr) +import GHC.Internal.Foreign.C.Types (CInt) + +-- * Obtaining POSIX file descriptors and Windows handles + +{-| + Executes a user-provided action on an operating-system handle that underlies + a Haskell handle. Before the user-provided action is run, user-defined + perparation based on the handle state that contains the operating-system + handle is performed. While the user-provided action is executed, further + operations on the Haskell handle are blocked to a degree that interference + with this action is prevented. + + See [below](#with-ref-caveats) for caveats regarding this operation. +-} +withOSHandle :: String + -- ^ The name of the overall operation + -> (Handle -> MVar Handle__) + {-^ + Obtaining of the handle state variable that holds the + operating-system handle + -} + -> (forall d. Typeable d => d -> IO a) + -- ^ Conversion of a device into an operating-system handle + -> (Handle__ -> IO ()) + -- ^ The preparation + -> Handle + -- ^ The Haskell handle to use + -> (a -> IO r) + -- ^ The action to execute on the operating-system handle + -> IO r +withOSHandle opName handleStateVar getOSHandle prepare handle act + = mask $ \ withOriginalMaskingState -> + withHandleState $ \ handleState@Handle__ {haDevice = dev} -> do + osHandle <- getOSHandle dev + prepare handleState + withOriginalMaskingState $ act osHandle + where + + withHandleState = withHandle_' opName handle (handleStateVar handle) +{- + The 'withHandle_'' operation, which we use here, already performs masking. + Still, we have to employ 'mask', in order do obtain the operation that + restores the original masking state. The user-provided action should be + executed with this original masking state, as there is no inherent reason to + generally perform it with masking in place. The masking that 'withHandle_'' + performs is only for safely accessing handle state and thus constitutes an + implementation detail; it has nothing to do with the user-provided action. +-} +{- + The order of actions in 'withOSHandle' is such that any exception from + 'getOSHandle' is thrown before the flushing of the Haskell-managed buffers. +-} + +{-| + Obtains the handle state variable that underlies a handle or specifically + the handle state variable for reading if the handle uses different state + variables for reading and writing. +-} +handleStateVarReadingBiased :: Handle -> MVar Handle__ +handleStateVarReadingBiased (FileHandle _ var) = var +handleStateVarReadingBiased (DuplexHandle _ readingVar _) = readingVar + +{-| + Obtains the handle state variable that underlies a handle or specifically + the handle state variable for writing if the handle uses different state + variables for reading and writing. +-} +handleStateVarWritingBiased :: Handle -> MVar Handle__ +handleStateVarWritingBiased (FileHandle _ var) = var +handleStateVarWritingBiased (DuplexHandle _ _ writingVar) = writingVar + +{-| + Yields the result of another operation if that operation succeeded, and + otherwise throws an exception that signals that the other operation failed + because some Haskell handle does not use an operating-system handle of a + required type. +-} +requiringOSHandleOfType :: String + -- ^ The name of the operating-system handle type + -> Maybe a + {-^ + The result of the other operation if it succeeded + -} + -> IO a +requiringOSHandleOfType osHandleTypeName + = maybe (ioException osHandleOfTypeRequired) return + where + + osHandleOfTypeRequired :: IOException + osHandleOfTypeRequired + = IOError Nothing + InappropriateType + "" + ("handle does not use " ++ osHandleTypeName ++ "s") + Nothing + Nothing + +{-| + Obtains the POSIX file descriptor of a device if the device contains one, + and throws an exception otherwise. +-} +getFileDescriptor :: Typeable d => d -> IO CInt +getFileDescriptor = requiringOSHandleOfType "POSIX file descriptor" . + fmap fdFD . cast + +{-| + Obtains the Windows handle of a device if the device contains one, and + throws an exception otherwise. +-} +getWindowsHandle :: Typeable d => d -> IO (Ptr ()) +getWindowsHandle = requiringOSHandleOfType "Windows handle" . + toMaybeWindowsHandle + where + + toMaybeWindowsHandle :: Typeable d => d -> Maybe (Ptr ()) +#if defined(mingw32_HOST_OS) + toMaybeWindowsHandle dev + | Just nativeHandle <- cast dev :: Maybe (IoHandle NativeHandle) + = Just (toHANDLE nativeHandle) + | Just consoleHandle <- cast dev :: Maybe (IoHandle ConsoleHandle) + = Just (toHANDLE consoleHandle) + | otherwise + = Nothing + {- + This is inspired by the implementation of + 'System.Win32.Types.withHandleToHANDLENative'. + -} +#else + toMaybeWindowsHandle _ = Nothing +#endif + +{-| + Executes a user-provided action on the POSIX file descriptor that underlies + a handle or specifically on the POSIX file descriptor for reading if the + handle uses different file descriptors for reading and writing. The + Haskell-managed buffers related to the file descriptor are flushed before + the user-provided action is run. While this action is executed, further + operations on the handle are blocked to a degree that interference with this + action is prevented. + + If the handle does not use POSIX file descriptors, an exception is thrown. + + See [below](#with-ref-caveats) for caveats regarding this operation. +-} +withFileDescriptorReadingBiased :: Handle -> (CInt -> IO r) -> IO r +withFileDescriptorReadingBiased = withOSHandle "withFileDescriptorReadingBiased" + handleStateVarReadingBiased + getFileDescriptor + flushBuffer + +{-| + Executes a user-provided action on the POSIX file descriptor that underlies + a handle or specifically on the POSIX file descriptor for writing if the + handle uses different file descriptors for reading and writing. The + Haskell-managed buffers related to the file descriptor are flushed before + the user-provided action is run. While this action is executed, further + operations on the handle are blocked to a degree that interference with this + action is prevented. + + If the handle does not use POSIX file descriptors, an exception is thrown. + + See [below](#with-ref-caveats) for caveats regarding this operation. +-} +withFileDescriptorWritingBiased :: Handle -> (CInt -> IO r) -> IO r +withFileDescriptorWritingBiased = withOSHandle "withFileDescriptorWritingBiased" + handleStateVarWritingBiased + getFileDescriptor + flushBuffer + +{-| + Executes a user-provided action on the Windows handle that underlies a + Haskell handle or specifically on the Windows handle for reading if the + Haskell handle uses different Windows handles for reading and writing. The + Haskell-managed buffers related to the Windows handle are flushed before the + user-provided action is run. While this action is executed, further + operations on the Haskell handle are blocked to a degree that interference + with this action is prevented. + + If the Haskell handle does not use Windows handles, an exception is thrown. + + See [below](#with-ref-caveats) for caveats regarding this operation. +-} +withWindowsHandleReadingBiased :: Handle -> (Ptr () -> IO r) -> IO r +withWindowsHandleReadingBiased = withOSHandle "withWindowsHandleReadingBiased" + handleStateVarReadingBiased + getWindowsHandle + flushBuffer + +{-| + Executes a user-provided action on the Windows handle that underlies a + Haskell handle or specifically on the Windows handle for writing if the + Haskell handle uses different Windows handles for reading and writing. The + Haskell-managed buffers related to the Windows handle are flushed before the + user-provided action is run. While this action is executed, further + operations on the Haskell handle are blocked to a degree that interference + with this action is prevented. + + If the Haskell handle does not use Windows handles, an exception is thrown. + + See [below](#with-ref-caveats) for caveats regarding this operation. +-} +withWindowsHandleWritingBiased :: Handle -> (Ptr () -> IO r) -> IO r +withWindowsHandleWritingBiased = withOSHandle "withWindowsHandleWritingBiased" + handleStateVarWritingBiased + getWindowsHandle + flushBuffer + +{-| + Like 'withFileDescriptorReadingBiased' except that Haskell-managed buffers + are not flushed. +-} +withFileDescriptorReadingBiasedRaw :: Handle -> (CInt -> IO r) -> IO r +withFileDescriptorReadingBiasedRaw + = withOSHandle "withFileDescriptorReadingBiasedRaw" + handleStateVarReadingBiased + getFileDescriptor + (const $ return ()) + +{-| + Like 'withFileDescriptorWritingBiased' except that Haskell-managed buffers + are not flushed. +-} +withFileDescriptorWritingBiasedRaw :: Handle -> (CInt -> IO r) -> IO r +withFileDescriptorWritingBiasedRaw + = withOSHandle "withFileDescriptorWritingBiasedRaw" + handleStateVarWritingBiased + getFileDescriptor + (const $ return ()) + +{-| + Like 'withWindowsHandleReadingBiased' except that Haskell-managed buffers + are not flushed. +-} +withWindowsHandleReadingBiasedRaw :: Handle -> (Ptr () -> IO r) -> IO r +withWindowsHandleReadingBiasedRaw + = withOSHandle "withWindowsHandleReadingBiasedRaw" + handleStateVarReadingBiased + getWindowsHandle + (const $ return ()) + +{-| + Like 'withWindowsHandleWritingBiased' except that Haskell-managed buffers + are not flushed. +-} +withWindowsHandleWritingBiasedRaw :: Handle -> (Ptr () -> IO r) -> IO r +withWindowsHandleWritingBiasedRaw + = withOSHandle "withWindowsHandleWritingBiasedRaw" + handleStateVarWritingBiased + getWindowsHandle + (const $ return ()) + +-- ** Caveats + +{-$with-ref-caveats + #with-ref-caveats#There are the following caveats regarding the above + operations: + + * Flushing of buffers can fail if the given handle is readable but not + seekable. + + * If one of these operations is performed as part of an action executed by + 'System.IO.Unsafe.unsafePerformIO', + 'System.IO.Unsafe.unsafeInterleaveIO', or one of their “dupable” + variants and the user-provided action receives an asychnchronous + exception and does not catch it, then the following happens: + + - Before the overall computation is suspended, the blocking of handle + operations is removed. + + - When the computation is later resumed due to another evaluation + attempt, the blocking of handle operations is reinstantiated, the + Haskell-managed buffers are flushed again, and the user-provided + action is run from the beginning. + + Repeating the previously executed part of the user-provided action + cannot be avoided apparently. See the @[async]@ note in the source code + of "GHC.Internal.IO.Handle.Internals" for further explanation. +-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4a0d5044ba801716b7e5f265e7b5cd9... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4a0d5044ba801716b7e5f265e7b5cd9... You're receiving this email because of your account on gitlab.haskell.org.