January 2026 - ghc-commits

[Git][ghc/ghc][wip/jeltsch/ghc-desugar-removal] 4 commits: PPC NCG: Generate clear right insn at arch width
by Wolfgang Jeltsch (＠jeltsch) 27 Jan '26

27 Jan '26

Wolfgang Jeltsch pushed to branch wip/jeltsch/ghc-desugar-removal at Glasgow Haskell Compiler / GHC Commits: 56db94f7 by Peter Trommler at 2026-01-26T11:26:18+01:00 PPC NCG: Generate clear right insn at arch width The clear right immediate (clrrxi) is only available in word and doubleword width. Generate clrrxi instructions at architecture width for all MachOp widths. Fixes #24145 - - - - - 5957a8ad by Wolfgang Jeltsch at 2026-01-27T06:11:40-05:00 Add operations for obtaining operating-system handles This contribution implements CLC proposal #369. It adds operations for obtaining POSIX file descriptors and Windows handles that underlie Haskell handles. Those operating system handles can also be obtained without such additional operations, but this is more involved and, more importantly, requires using internals. - - - - - 86a0510c by Greg Steuck at 2026-01-27T06:12:34-05:00 Move flags to precede patterns for grep and read files directly This makes the tests pass with non-GNU (i.e. POSIX-complicant) tools. There's no reason to use cat and pipe where direct file argument works. - - - - - 3c601974 by Wolfgang Jeltsch at 2026-01-27T13:47:37+02:00 Remove `GHC.Desugar` from `base` `GHC.Desugar` was deprecated and should have been removed in GHC 9.14. However, the removal was forgotten, although there was a code block that was intended to trigger a compilation error when the GHC version in use was 9.14 or later. This code sadly didn’t work, because the `__GLASGOW_HASKELL__` macro was misspelled as `__GLASGOW_HASKELL`. - - - - - 27 changed files: - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - libraries/base/base.cabal.in - libraries/base/changelog.md - − libraries/base/src/GHC/Desugar.hs - + libraries/base/src/System/IO/OS.hs - libraries/base/tests/IO/all.T - + libraries/base/tests/IO/osHandles001FileDescriptors.hs - + libraries/base/tests/IO/osHandles001FileDescriptors.stdout - + libraries/base/tests/IO/osHandles001WindowsHandles.hs - + libraries/base/tests/IO/osHandles001WindowsHandles.stdout - + libraries/base/tests/IO/osHandles002FileDescriptors.hs - + libraries/base/tests/IO/osHandles002FileDescriptors.stderr - + libraries/base/tests/IO/osHandles002FileDescriptors.stdin - + libraries/base/tests/IO/osHandles002FileDescriptors.stdout - + libraries/base/tests/IO/osHandles002WindowsHandles.hs - + libraries/base/tests/IO/osHandles002WindowsHandles.stderr - + libraries/base/tests/IO/osHandles002WindowsHandles.stdin - + libraries/base/tests/IO/osHandles002WindowsHandles.stdout - libraries/base/tests/perf/Makefile - libraries/ghc-internal/ghc-internal.cabal.in - + libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs - testsuite/tests/driver/T16318/Makefile - testsuite/tests/driver/T18125/Makefile - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 Changes: ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -539,7 +539,7 @@ getRegister' config platform (CmmMachOp mop [x]) -- unary MachOps CLRLI arch_fmt dst src1 (arch_bits - size) return (Any (intFormat to) code) -getRegister' _ _ (CmmMachOp mop [x, y]) -- dyadic PrimOps +getRegister' _ platform (CmmMachOp mop [x, y]) -- dyadic PrimOps = case mop of MO_F_Eq _ -> condFltReg EQQ x y MO_F_Ne _ -> condFltReg NE x y @@ -622,8 +622,9 @@ getRegister' _ _ (CmmMachOp mop [x, y]) -- dyadic PrimOps (src, srcCode) <- getSomeReg x let clear_mask = if imm == -4 then 2 else 3 fmt = intFormat rep + arch_fmt = intFormat (wordWidth platform) code dst = srcCode - `appOL` unitOL (CLRRI fmt dst src clear_mask) + `appOL` unitOL (CLRRI arch_fmt dst src clear_mask) return (Any fmt code) _ -> trivialCode rep False AND x y MO_Or rep -> trivialCode rep False OR x y ===================================== libraries/base/base.cabal.in ===================================== @@ -161,7 +161,6 @@ Library , GHC.Conc.Sync , GHC.ConsoleHandler , GHC.Constants - , GHC.Desugar , GHC.Encoding.UTF8 , GHC.Enum , GHC.Environment @@ -255,6 +254,7 @@ Library , System.Exit , System.IO , System.IO.Error + , System.IO.OS , System.Mem , System.Mem.StableName , System.Posix.Internals ===================================== libraries/base/changelog.md ===================================== @@ -23,6 +23,7 @@ * `GHC.Conc.catchSTM` and `GHC.Conc.Sync.catchSTM` now attach `WhileHandling` annotation to exceptions thrown from the handler. ([GHC #25365](https://gitlab.haskell.org/ghc/ghc/-/issues/25365)) * Remove `GHC.JS.Prim.Internal.Build`, as per [CLC #329](https://github.com/haskell/core-libraries-committee/issues/329) * Export `labelThread` from `Control.Concurrent`.([CLC proposal #376](https://github.com/haskell/core-libraries-committee/issues/376)) + * Add a new module `System.IO.OS` with operations for obtaining operating-system handles (file descriptors, Windows handles). ([CLC proposal #369](https://github.com/haskell/core-libraries-committee/issues/369)) ## 4.22.0.0 *TBA* * Shipped with GHC 9.14.1 ===================================== libraries/base/src/GHC/Desugar.hs deleted ===================================== @@ -1,33 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE Safe #-} -{-# OPTIONS_HADDOCK not-home #-} - ------------------------------------------------------------------------------ --- | --- --- Module : GHC.Desugar --- Copyright : (c) The University of Glasgow, 2007 --- License : see libraries/base/LICENSE --- --- Maintainer : ghc-devs(a)haskell.org --- Stability : deprecated (<https://github.com/haskell/core-libraries-committee/issues/216>) --- Portability : non-portable (GHC extensions) --- --- Support code for desugaring in GHC --- --- /The API of this module is unstable and not meant to be consumed by the general public./ --- If you absolutely must depend on it, make sure to use a tight upper --- bound, e.g., @base < 4.X@ rather than @base < 5@, because the interface can --- change rapidly without much warning. --- ------------------------------------------------------------------------------ - -#if __GLASGOW_HASKELL >= 914 -#error "GHC.Desugar should be removed in GHC 9.14" -#endif - -module GHC.Desugar - {-# DEPRECATED ["GHC.Desugar is deprecated and will be removed in GHC 9.14.", "(>>>) should be imported from Control.Arrow.", "AnnotationWrapper is internal to GHC and should not be used externally."] #-} - ((>>>), AnnotationWrapper(..), toAnnotationWrapper) where - -import GHC.Internal.Desugar ===================================== libraries/base/src/System/IO/OS.hs ===================================== @@ -0,0 +1,62 @@ +{-# LANGUAGE Safe #-} + +{-| + This module bridges between Haskell handles and underlying operating-system + features. +-} +module 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.System.IO.OS + ( + withFileDescriptorReadingBiased, + withFileDescriptorWritingBiased, + withWindowsHandleReadingBiased, + withWindowsHandleWritingBiased, + withFileDescriptorReadingBiasedRaw, + withFileDescriptorWritingBiasedRaw, + withWindowsHandleReadingBiasedRaw, + withWindowsHandleWritingBiasedRaw + ) + +-- ** 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. +-} ===================================== libraries/base/tests/IO/all.T ===================================== @@ -186,3 +186,15 @@ test('T17912', [only_ways(['threaded1']), when(opsys('mingw32'),expect_broken(1) test('T18832', only_ways(['threaded1']), compile_and_run, ['']) test('mkdirExists', [exit_code(1), when(opsys('mingw32'), ignore_stderr)], compile_and_run, ['']) + +test('osHandles001FileDescriptors', omit_ways(['winio', 'winio_threaded']), compile_and_run, ['']) +test('osHandles001WindowsHandles', only_ways(['winio', 'winio_threaded']), compile_and_run, ['']) +test('osHandles002FileDescriptors', [when(opsys('mingw32'), skip), when(arch('javascript'), skip)], compile_and_run, ['']) +test('osHandles002WindowsHandles', only_ways(['winio', 'winio_threaded']), compile_and_run, ['']) +# It would be good to let `osHandles002FileDescriptors` run also on +# Windows with the file-descriptor-based I/O manager. However, this +# test, as it is currently implemented, requires the `unix` package. +# That said, `UCRT.DLL`, which is used by GHC-generated Windows +# executables, emulates part of POSIX, enough for this test. As a +# result, this test could be generalized to also supporting Windows, but +# this would likely involve creating bindings to C code. ===================================== libraries/base/tests/IO/osHandles001FileDescriptors.hs ===================================== @@ -0,0 +1,23 @@ +{-# LANGUAGE TypeApplications #-} + +import Control.Monad (mapM_) +import Control.Exception (SomeException, try) +import System.IO (stdin, stdout, stderr) +import System.IO.OS + ( + withFileDescriptorReadingBiasedRaw, + withFileDescriptorWritingBiasedRaw, + withWindowsHandleReadingBiasedRaw, + withWindowsHandleWritingBiasedRaw + ) + +main :: IO () +main = mapM_ ((>>= print) . try @SomeException) $ + [ + withFileDescriptorReadingBiasedRaw stdin (return . show), + withFileDescriptorWritingBiasedRaw stdout (return . show), + withFileDescriptorWritingBiasedRaw stderr (return . show), + withWindowsHandleReadingBiasedRaw stdin (return . const "_"), + withWindowsHandleWritingBiasedRaw stdout (return . const "_"), + withWindowsHandleWritingBiasedRaw stderr (return . const "_") + ] ===================================== libraries/base/tests/IO/osHandles001FileDescriptors.stdout ===================================== @@ -0,0 +1,6 @@ +Right "0" +Right "1" +Right "2" +Left <stdin>: withWindowsHandleReadingBiasedRaw: inappropriate type (handle does not use Windows handles) +Left <stdout>: withWindowsHandleWritingBiasedRaw: inappropriate type (handle does not use Windows handles) +Left <stderr>: withWindowsHandleWritingBiasedRaw: inappropriate type (handle does not use Windows handles) ===================================== libraries/base/tests/IO/osHandles001WindowsHandles.hs ===================================== @@ -0,0 +1,23 @@ +{-# LANGUAGE TypeApplications #-} + +import Control.Monad (mapM_) +import Control.Exception (SomeException, try) +import System.IO (stdin, stdout, stderr) +import System.IO.OS + ( + withFileDescriptorReadingBiasedRaw, + withFileDescriptorWritingBiasedRaw, + withWindowsHandleReadingBiasedRaw, + withWindowsHandleWritingBiasedRaw + ) + +main :: IO () +main = mapM_ ((>>= print) . try @SomeException) $ + [ + withFileDescriptorReadingBiasedRaw stdin (return . show), + withFileDescriptorWritingBiasedRaw stdout (return . show), + withFileDescriptorWritingBiasedRaw stderr (return . show), + withWindowsHandleReadingBiasedRaw stdin (return . const "_"), + withWindowsHandleWritingBiasedRaw stdout (return . const "_"), + withWindowsHandleWritingBiasedRaw stderr (return . const "_") + ] ===================================== libraries/base/tests/IO/osHandles001WindowsHandles.stdout ===================================== @@ -0,0 +1,6 @@ +Left <stdin>: withFileDescriptorReadingBiasedRaw: inappropriate type (handle does not use file descriptors) +Left <stdout>: withFileDescriptorWritingBiasedRaw: inappropriate type (handle does not use file descriptors) +Left <stderr>: withFileDescriptorWritingBiasedRaw: inappropriate type (handle does not use file descriptors) +Right "_" +Right "_" +Right "_" ===================================== libraries/base/tests/IO/osHandles002FileDescriptors.hs ===================================== @@ -0,0 +1,28 @@ +import Data.Functor (void) +import Data.ByteString.Char8 (pack) +import System.Posix.Types (Fd (Fd), ByteCount) +import System.Posix.IO.ByteString (fdRead, fdWrite) +import System.IO (stdin, stdout, stderr) +import System.IO.OS + ( + withFileDescriptorReadingBiased, + withFileDescriptorWritingBiased + ) + +main :: IO () +main = withFileDescriptorReadingBiased stdin $ \ stdinFD -> + withFileDescriptorWritingBiased stdout $ \ stdoutFD -> + withFileDescriptorWritingBiased stderr $ \ stderrFD -> + do + regularMsg <- fdRead (Fd stdinFD) inputSizeApproximation + void $ fdWrite (Fd stdoutFD) regularMsg + void $ fdWrite (Fd stderrFD) (pack errorMsg) + where + + inputSizeApproximation :: ByteCount + inputSizeApproximation = 100 + + errorMsg :: String + errorMsg = "And every single door\n\ + \That I've walked through\n\ + \Brings me back, back here again\n" ===================================== libraries/base/tests/IO/osHandles002FileDescriptors.stderr ===================================== @@ -0,0 +1,3 @@ +And every single door +That I've walked through +Brings me back, back here again ===================================== libraries/base/tests/IO/osHandles002FileDescriptors.stdin ===================================== @@ -0,0 +1 @@ +We've got to get in to get out ===================================== libraries/base/tests/IO/osHandles002FileDescriptors.stdout ===================================== @@ -0,0 +1 @@ +We've got to get in to get out ===================================== libraries/base/tests/IO/osHandles002WindowsHandles.hs ===================================== @@ -0,0 +1,49 @@ +import Control.Monad (zipWithM_) +import Data.Functor (void) +import Data.Char (ord) +import Foreign.Marshal.Alloc (allocaBytes) +import Foreign.Storable (pokeElemOff) +import System.IO (stdin, stdout, stderr) +import System.IO.OS + ( + withWindowsHandleReadingBiased, + withWindowsHandleWritingBiased + ) + +main :: IO () +main = withWindowsHandleReadingBiased stdin $ \ windowsStdin -> + withWindowsHandleWritingBiased stdout $ \ windowsStdout -> + withWindowsHandleWritingBiased stderr $ \ windowsStderr -> + do + withBuffer inputSizeApproximation $ \ bufferPtr -> do + inputSize <- win32_ReadFile windowsStdin + bufferPtr + inputSizeApproximation + Nothing + void $ win32_WriteFile windowsStdout + bufferPtr + inputSize + Nothing + withBuffer errorMsgSize $ \ bufferPtr -> do + zipWithM_ (pokeElemOff bufferPtr) + [0 ..] + (map (fromIntegral . ord) errorMsg) + void $ win32_WriteFile windowsStderr + bufferPtr + errorMsgSize + Nothing + where + + withBuffer :: DWORD -> (Ptr Word8 -> IO a) -> IO a + withBuffer = allocaBytes . fromIntegral + + inputSizeApproximation :: DWORD + inputSizeApproximation = 100 + + errorMsg :: String + errorMsg = "And every single door\n\ + \That I've walked through\n\ + \Brings me back, back here again\n" + + errorMsgSize :: DWORD + errorMsgSize = fromIntegral (length errorMsg) ===================================== libraries/base/tests/IO/osHandles002WindowsHandles.stderr ===================================== @@ -0,0 +1,3 @@ +And every single door +That I've walked through +Brings me back, back here again ===================================== libraries/base/tests/IO/osHandles002WindowsHandles.stdin ===================================== @@ -0,0 +1 @@ +We've got to get in to get out ===================================== libraries/base/tests/IO/osHandles002WindowsHandles.stdout ===================================== @@ -0,0 +1 @@ +We've got to get in to get out ===================================== libraries/base/tests/perf/Makefile ===================================== @@ -12,4 +12,4 @@ T17752: # All occurrences of elem should be optimized away. # For strings these should result in loops after inlining foldCString. # For lists it should result in a case expression. - echo $$(cat T17752.dump-simpl | grep "elem" -A4 ) + echo $$(grep -A4 "elem" T17752.dump-simpl) ===================================== libraries/ghc-internal/ghc-internal.cabal.in ===================================== @@ -328,6 +328,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,323 @@ +{-# 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 + preparation 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 user-defined preparation is performed. +-} + +{-| + 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#This subsection is just a dummy, whose purpose is to serve + as the target of the hyperlinks above. The real documentation of the caveats + is in the /Caveats/ subsection in the @base@ module @System.IO.OS@, which + re-exports the above operations. +-} ===================================== testsuite/tests/driver/T16318/Makefile ===================================== @@ -7,5 +7,5 @@ test_pe = test-package-environment T16318: "$(GHC_PKG)" field base id --simple-output > $(test_pe) "$(TEST_HC)" $(TEST_HC_OPTS) -v1 -ignore-dot-ghci -package-env $(test_pe) -e "putStrLn \"Hello\"" > out 2>&1 - C=`cat out | grep "Loaded package environment" -c` ; \ + C=`grep -c "Loaded package environment" out` ; \ if [ $$C != "1" ]; then false; fi ===================================== testsuite/tests/driver/T18125/Makefile ===================================== @@ -9,5 +9,5 @@ T18125: "$(GHC_PKG)" field base id --simple-output > $(test_pe) "$(GHC_PKG)" field $(test_lib) id --simple-outpu >> $(test_pe) "$(TEST_HC)" $(TEST_HC_OPTS) -Wunused-packages -package-env $(test_pe) T18125.hs > out 2>&1 - C=`cat out | grep "$(test_lib)" -c` ; \ + C=`grep -c "$(test_lib)" out` ; \ if [ $$C != "1" ]; then false; fi ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -5212,13 +5212,6 @@ module GHC.ConsoleHandler where module GHC.Constants where -- Safety: None -module GHC.Desugar where - -- Safety: Safe - (>>>) :: forall (arr :: * -> * -> *) a b c. GHC.Internal.Control.Arrow.Arrow arr => arr a b -> arr b c -> arr a c - type AnnotationWrapper :: * - data AnnotationWrapper = forall a. GHC.Internal.Data.Data.Data a => AnnotationWrapper a - toAnnotationWrapper :: forall a. GHC.Internal.Data.Data.Data a => a -> AnnotationWrapper - module GHC.Encoding.UTF8 where -- Safety: None utf8CompareByteArray# :: GHC.Internal.Prim.ByteArray# -> GHC.Internal.Prim.ByteArray# -> GHC.Internal.Types.Ordering @@ -10048,6 +10041,17 @@ module System.IO.Error where userError :: GHC.Internal.Base.String -> IOError userErrorType :: IOErrorType +module System.IO.OS where + -- Safety: Safe + withFileDescriptorReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + module System.IO.Unsafe where -- Safety: Unsafe unsafeDupablePerformIO :: forall a. GHC.Internal.Types.IO a -> a ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -5212,13 +5212,6 @@ module GHC.ConsoleHandler where module GHC.Constants where -- Safety: None -module GHC.Desugar where - -- Safety: Safe - (>>>) :: forall (arr :: * -> * -> *) a b c. GHC.Internal.Control.Arrow.Arrow arr => arr a b -> arr b c -> arr a c - type AnnotationWrapper :: * - data AnnotationWrapper = forall a. GHC.Internal.Data.Data.Data a => AnnotationWrapper a - toAnnotationWrapper :: forall a. GHC.Internal.Data.Data.Data a => a -> AnnotationWrapper - module GHC.Encoding.UTF8 where -- Safety: None utf8CompareByteArray# :: GHC.Internal.Prim.ByteArray# -> GHC.Internal.Prim.ByteArray# -> GHC.Internal.Types.Ordering @@ -10086,6 +10079,17 @@ module System.IO.Error where userError :: GHC.Internal.Base.String -> IOError userErrorType :: IOErrorType +module System.IO.OS where + -- Safety: Safe + withFileDescriptorReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + module System.IO.Unsafe where -- Safety: Unsafe unsafeDupablePerformIO :: forall a. GHC.Internal.Types.IO a -> a ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -5257,13 +5257,6 @@ module GHC.ConsoleHandler where module GHC.Constants where -- Safety: None -module GHC.Desugar where - -- Safety: Safe - (>>>) :: forall (arr :: * -> * -> *) a b c. GHC.Internal.Control.Arrow.Arrow arr => arr a b -> arr b c -> arr a c - type AnnotationWrapper :: * - data AnnotationWrapper = forall a. GHC.Internal.Data.Data.Data a => AnnotationWrapper a - toAnnotationWrapper :: forall a. GHC.Internal.Data.Data.Data a => a -> AnnotationWrapper - module GHC.Encoding.UTF8 where -- Safety: None utf8CompareByteArray# :: GHC.Internal.Prim.ByteArray# -> GHC.Internal.Prim.ByteArray# -> GHC.Internal.Types.Ordering @@ -10328,6 +10321,17 @@ module System.IO.Error where userError :: GHC.Internal.Base.String -> IOError userErrorType :: IOErrorType +module System.IO.OS where + -- Safety: Safe + withFileDescriptorReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + module System.IO.Unsafe where -- Safety: Unsafe unsafeDupablePerformIO :: forall a. GHC.Internal.Types.IO a -> a ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -5212,13 +5212,6 @@ module GHC.ConsoleHandler where module GHC.Constants where -- Safety: None -module GHC.Desugar where - -- Safety: Safe - (>>>) :: forall (arr :: * -> * -> *) a b c. GHC.Internal.Control.Arrow.Arrow arr => arr a b -> arr b c -> arr a c - type AnnotationWrapper :: * - data AnnotationWrapper = forall a. GHC.Internal.Data.Data.Data a => AnnotationWrapper a - toAnnotationWrapper :: forall a. GHC.Internal.Data.Data.Data a => a -> AnnotationWrapper - module GHC.Encoding.UTF8 where -- Safety: None utf8CompareByteArray# :: GHC.Internal.Prim.ByteArray# -> GHC.Internal.Prim.ByteArray# -> GHC.Internal.Types.Ordering @@ -10048,6 +10041,17 @@ module System.IO.Error where userError :: GHC.Internal.Base.String -> IOError userErrorType :: IOErrorType +module System.IO.OS where + -- Safety: Safe + withFileDescriptorReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + module System.IO.Unsafe where -- Safety: Unsafe unsafeDupablePerformIO :: forall a. GHC.Internal.Types.IO a -> a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9010a9ff8172b3b52009c4119bfde4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9010a9ff8172b3b52009c4119bfde4… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/jeltsch/obtaining-os-handles
by Wolfgang Jeltsch (＠jeltsch) 27 Jan '26

27 Jan '26

Wolfgang Jeltsch deleted branch wip/jeltsch/obtaining-os-handles at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/t26751] 4 commits: PPC NCG: Generate clear right insn at arch width
by Matthew Pickering (＠mpickering) 27 Jan '26

27 Jan '26

Matthew Pickering pushed to branch wip/t26751 at Glasgow Haskell Compiler / GHC Commits: 56db94f7 by Peter Trommler at 2026-01-26T11:26:18+01:00 PPC NCG: Generate clear right insn at arch width The clear right immediate (clrrxi) is only available in word and doubleword width. Generate clrrxi instructions at architecture width for all MachOp widths. Fixes #24145 - - - - - 5957a8ad by Wolfgang Jeltsch at 2026-01-27T06:11:40-05:00 Add operations for obtaining operating-system handles This contribution implements CLC proposal #369. It adds operations for obtaining POSIX file descriptors and Windows handles that underlie Haskell handles. Those operating system handles can also be obtained without such additional operations, but this is more involved and, more importantly, requires using internals. - - - - - 86a0510c by Greg Steuck at 2026-01-27T06:12:34-05:00 Move flags to precede patterns for grep and read files directly This makes the tests pass with non-GNU (i.e. POSIX-complicant) tools. There's no reason to use cat and pipe where direct file argument works. - - - - - d66cb504 by Matthew Pickering at 2026-01-27T11:40:07+00:00 Evaluate backtraces for "error" exceptions at the moment they are thrown See Note [Capturing the backtrace in throw] and Note [Hiding precise exception signature in throw] which explain the implementation. This commit makes `error` and `throw` behave the same with regard to backtraces. Previously, exceptions raised by `error` would not contain useful IPE backtraces. I did try and implement `error` in terms of `throw` but it started to involve putting diverging functions into hs-boot files, which seemed to risky if the compiler wouldn't be able to see if applying a function would diverge. CLC proposal: https://github.com/haskell/core-libraries-committee/issues/383 Fixes #26751 - - - - - 34 changed files: - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - libraries/base/base.cabal.in - libraries/base/changelog.md - + libraries/base/src/System/IO/OS.hs - libraries/base/tests/IO/all.T - + libraries/base/tests/IO/osHandles001FileDescriptors.hs - + libraries/base/tests/IO/osHandles001FileDescriptors.stdout - + libraries/base/tests/IO/osHandles001WindowsHandles.hs - + libraries/base/tests/IO/osHandles001WindowsHandles.stdout - + libraries/base/tests/IO/osHandles002FileDescriptors.hs - + libraries/base/tests/IO/osHandles002FileDescriptors.stderr - + libraries/base/tests/IO/osHandles002FileDescriptors.stdin - + libraries/base/tests/IO/osHandles002FileDescriptors.stdout - + libraries/base/tests/IO/osHandles002WindowsHandles.hs - + libraries/base/tests/IO/osHandles002WindowsHandles.stderr - + libraries/base/tests/IO/osHandles002WindowsHandles.stdin - + libraries/base/tests/IO/osHandles002WindowsHandles.stdout - libraries/base/tests/perf/Makefile - libraries/ghc-internal/ghc-internal.cabal.in - libraries/ghc-internal/src/GHC/Internal/Err.hs - + libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs - libraries/ghc-internal/tests/stack-annotation/all.T - + libraries/ghc-internal/tests/stack-annotation/ann_frame005.hs - + libraries/ghc-internal/tests/stack-annotation/ann_frame005.stdout - testsuite/tests/driver/T16318/Makefile - testsuite/tests/driver/T18125/Makefile - testsuite/tests/ghci.debugger/scripts/T8487.stdout - testsuite/tests/ghci.debugger/scripts/break011.stdout - testsuite/tests/ghci.debugger/scripts/break017.stdout - testsuite/tests/ghci.debugger/scripts/break025.stdout - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48c2d53aee27cd6022354813bba30a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48c2d53aee27cd6022354813bba30a… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Move flags to precede patterns for grep and read files directly
by Marge Bot (＠marge-bot) 27 Jan '26

27 Jan '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 86a0510c by Greg Steuck at 2026-01-27T06:12:34-05:00 Move flags to precede patterns for grep and read files directly This makes the tests pass with non-GNU (i.e. POSIX-complicant) tools. There's no reason to use cat and pipe where direct file argument works. - - - - - 3 changed files: - libraries/base/tests/perf/Makefile - testsuite/tests/driver/T16318/Makefile - testsuite/tests/driver/T18125/Makefile Changes: ===================================== libraries/base/tests/perf/Makefile ===================================== @@ -12,4 +12,4 @@ T17752: # All occurrences of elem should be optimized away. # For strings these should result in loops after inlining foldCString. # For lists it should result in a case expression. - echo $$(cat T17752.dump-simpl | grep "elem" -A4 ) + echo $$(grep -A4 "elem" T17752.dump-simpl) ===================================== testsuite/tests/driver/T16318/Makefile ===================================== @@ -7,5 +7,5 @@ test_pe = test-package-environment T16318: "$(GHC_PKG)" field base id --simple-output > $(test_pe) "$(TEST_HC)" $(TEST_HC_OPTS) -v1 -ignore-dot-ghci -package-env $(test_pe) -e "putStrLn \"Hello\"" > out 2>&1 - C=`cat out | grep "Loaded package environment" -c` ; \ + C=`grep -c "Loaded package environment" out` ; \ if [ $$C != "1" ]; then false; fi ===================================== testsuite/tests/driver/T18125/Makefile ===================================== @@ -9,5 +9,5 @@ T18125: "$(GHC_PKG)" field base id --simple-output > $(test_pe) "$(GHC_PKG)" field $(test_lib) id --simple-outpu >> $(test_pe) "$(TEST_HC)" $(TEST_HC_OPTS) -Wunused-packages -package-env $(test_pe) T18125.hs > out 2>&1 - C=`cat out | grep "$(test_lib)" -c` ; \ + C=`grep -c "$(test_lib)" out` ; \ if [ $$C != "1" ]; then false; fi View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86a0510cfa67417ab9331f0e1c714ae… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86a0510cfa67417ab9331f0e1c714ae… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Add operations for obtaining operating-system handles
by Marge Bot (＠marge-bot) 27 Jan '26

27 Jan '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5957a8ad by Wolfgang Jeltsch at 2026-01-27T06:11:40-05:00 Add operations for obtaining operating-system handles This contribution implements CLC proposal #369. It adds operations for obtaining POSIX file descriptors and Windows handles that underlie Haskell handles. Those operating system handles can also be obtained without such additional operations, but this is more involved and, more importantly, requires using internals. - - - - - 22 changed files: - libraries/base/base.cabal.in - libraries/base/changelog.md - + libraries/base/src/System/IO/OS.hs - libraries/base/tests/IO/all.T - + libraries/base/tests/IO/osHandles001FileDescriptors.hs - + libraries/base/tests/IO/osHandles001FileDescriptors.stdout - + libraries/base/tests/IO/osHandles001WindowsHandles.hs - + libraries/base/tests/IO/osHandles001WindowsHandles.stdout - + libraries/base/tests/IO/osHandles002FileDescriptors.hs - + libraries/base/tests/IO/osHandles002FileDescriptors.stderr - + libraries/base/tests/IO/osHandles002FileDescriptors.stdin - + libraries/base/tests/IO/osHandles002FileDescriptors.stdout - + libraries/base/tests/IO/osHandles002WindowsHandles.hs - + libraries/base/tests/IO/osHandles002WindowsHandles.stderr - + libraries/base/tests/IO/osHandles002WindowsHandles.stdin - + libraries/base/tests/IO/osHandles002WindowsHandles.stdout - libraries/ghc-internal/ghc-internal.cabal.in - + libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 Changes: ===================================== libraries/base/base.cabal.in ===================================== @@ -255,6 +255,7 @@ Library , System.Exit , System.IO , System.IO.Error + , System.IO.OS , System.Mem , System.Mem.StableName , System.Posix.Internals ===================================== libraries/base/changelog.md ===================================== @@ -23,6 +23,7 @@ * `GHC.Conc.catchSTM` and `GHC.Conc.Sync.catchSTM` now attach `WhileHandling` annotation to exceptions thrown from the handler. ([GHC #25365](https://gitlab.haskell.org/ghc/ghc/-/issues/25365)) * Remove `GHC.JS.Prim.Internal.Build`, as per [CLC #329](https://github.com/haskell/core-libraries-committee/issues/329) * Export `labelThread` from `Control.Concurrent`.([CLC proposal #376](https://github.com/haskell/core-libraries-committee/issues/376)) + * Add a new module `System.IO.OS` with operations for obtaining operating-system handles (file descriptors, Windows handles). ([CLC proposal #369](https://github.com/haskell/core-libraries-committee/issues/369)) ## 4.22.0.0 *TBA* * Shipped with GHC 9.14.1 ===================================== libraries/base/src/System/IO/OS.hs ===================================== @@ -0,0 +1,62 @@ +{-# LANGUAGE Safe #-} + +{-| + This module bridges between Haskell handles and underlying operating-system + features. +-} +module 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.System.IO.OS + ( + withFileDescriptorReadingBiased, + withFileDescriptorWritingBiased, + withWindowsHandleReadingBiased, + withWindowsHandleWritingBiased, + withFileDescriptorReadingBiasedRaw, + withFileDescriptorWritingBiasedRaw, + withWindowsHandleReadingBiasedRaw, + withWindowsHandleWritingBiasedRaw + ) + +-- ** 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. +-} ===================================== libraries/base/tests/IO/all.T ===================================== @@ -186,3 +186,15 @@ test('T17912', [only_ways(['threaded1']), when(opsys('mingw32'),expect_broken(1) test('T18832', only_ways(['threaded1']), compile_and_run, ['']) test('mkdirExists', [exit_code(1), when(opsys('mingw32'), ignore_stderr)], compile_and_run, ['']) + +test('osHandles001FileDescriptors', omit_ways(['winio', 'winio_threaded']), compile_and_run, ['']) +test('osHandles001WindowsHandles', only_ways(['winio', 'winio_threaded']), compile_and_run, ['']) +test('osHandles002FileDescriptors', [when(opsys('mingw32'), skip), when(arch('javascript'), skip)], compile_and_run, ['']) +test('osHandles002WindowsHandles', only_ways(['winio', 'winio_threaded']), compile_and_run, ['']) +# It would be good to let `osHandles002FileDescriptors` run also on +# Windows with the file-descriptor-based I/O manager. However, this +# test, as it is currently implemented, requires the `unix` package. +# That said, `UCRT.DLL`, which is used by GHC-generated Windows +# executables, emulates part of POSIX, enough for this test. As a +# result, this test could be generalized to also supporting Windows, but +# this would likely involve creating bindings to C code. ===================================== libraries/base/tests/IO/osHandles001FileDescriptors.hs ===================================== @@ -0,0 +1,23 @@ +{-# LANGUAGE TypeApplications #-} + +import Control.Monad (mapM_) +import Control.Exception (SomeException, try) +import System.IO (stdin, stdout, stderr) +import System.IO.OS + ( + withFileDescriptorReadingBiasedRaw, + withFileDescriptorWritingBiasedRaw, + withWindowsHandleReadingBiasedRaw, + withWindowsHandleWritingBiasedRaw + ) + +main :: IO () +main = mapM_ ((>>= print) . try @SomeException) $ + [ + withFileDescriptorReadingBiasedRaw stdin (return . show), + withFileDescriptorWritingBiasedRaw stdout (return . show), + withFileDescriptorWritingBiasedRaw stderr (return . show), + withWindowsHandleReadingBiasedRaw stdin (return . const "_"), + withWindowsHandleWritingBiasedRaw stdout (return . const "_"), + withWindowsHandleWritingBiasedRaw stderr (return . const "_") + ] ===================================== libraries/base/tests/IO/osHandles001FileDescriptors.stdout ===================================== @@ -0,0 +1,6 @@ +Right "0" +Right "1" +Right "2" +Left <stdin>: withWindowsHandleReadingBiasedRaw: inappropriate type (handle does not use Windows handles) +Left <stdout>: withWindowsHandleWritingBiasedRaw: inappropriate type (handle does not use Windows handles) +Left <stderr>: withWindowsHandleWritingBiasedRaw: inappropriate type (handle does not use Windows handles) ===================================== libraries/base/tests/IO/osHandles001WindowsHandles.hs ===================================== @@ -0,0 +1,23 @@ +{-# LANGUAGE TypeApplications #-} + +import Control.Monad (mapM_) +import Control.Exception (SomeException, try) +import System.IO (stdin, stdout, stderr) +import System.IO.OS + ( + withFileDescriptorReadingBiasedRaw, + withFileDescriptorWritingBiasedRaw, + withWindowsHandleReadingBiasedRaw, + withWindowsHandleWritingBiasedRaw + ) + +main :: IO () +main = mapM_ ((>>= print) . try @SomeException) $ + [ + withFileDescriptorReadingBiasedRaw stdin (return . show), + withFileDescriptorWritingBiasedRaw stdout (return . show), + withFileDescriptorWritingBiasedRaw stderr (return . show), + withWindowsHandleReadingBiasedRaw stdin (return . const "_"), + withWindowsHandleWritingBiasedRaw stdout (return . const "_"), + withWindowsHandleWritingBiasedRaw stderr (return . const "_") + ] ===================================== libraries/base/tests/IO/osHandles001WindowsHandles.stdout ===================================== @@ -0,0 +1,6 @@ +Left <stdin>: withFileDescriptorReadingBiasedRaw: inappropriate type (handle does not use file descriptors) +Left <stdout>: withFileDescriptorWritingBiasedRaw: inappropriate type (handle does not use file descriptors) +Left <stderr>: withFileDescriptorWritingBiasedRaw: inappropriate type (handle does not use file descriptors) +Right "_" +Right "_" +Right "_" ===================================== libraries/base/tests/IO/osHandles002FileDescriptors.hs ===================================== @@ -0,0 +1,28 @@ +import Data.Functor (void) +import Data.ByteString.Char8 (pack) +import System.Posix.Types (Fd (Fd), ByteCount) +import System.Posix.IO.ByteString (fdRead, fdWrite) +import System.IO (stdin, stdout, stderr) +import System.IO.OS + ( + withFileDescriptorReadingBiased, + withFileDescriptorWritingBiased + ) + +main :: IO () +main = withFileDescriptorReadingBiased stdin $ \ stdinFD -> + withFileDescriptorWritingBiased stdout $ \ stdoutFD -> + withFileDescriptorWritingBiased stderr $ \ stderrFD -> + do + regularMsg <- fdRead (Fd stdinFD) inputSizeApproximation + void $ fdWrite (Fd stdoutFD) regularMsg + void $ fdWrite (Fd stderrFD) (pack errorMsg) + where + + inputSizeApproximation :: ByteCount + inputSizeApproximation = 100 + + errorMsg :: String + errorMsg = "And every single door\n\ + \That I've walked through\n\ + \Brings me back, back here again\n" ===================================== libraries/base/tests/IO/osHandles002FileDescriptors.stderr ===================================== @@ -0,0 +1,3 @@ +And every single door +That I've walked through +Brings me back, back here again ===================================== libraries/base/tests/IO/osHandles002FileDescriptors.stdin ===================================== @@ -0,0 +1 @@ +We've got to get in to get out ===================================== libraries/base/tests/IO/osHandles002FileDescriptors.stdout ===================================== @@ -0,0 +1 @@ +We've got to get in to get out ===================================== libraries/base/tests/IO/osHandles002WindowsHandles.hs ===================================== @@ -0,0 +1,49 @@ +import Control.Monad (zipWithM_) +import Data.Functor (void) +import Data.Char (ord) +import Foreign.Marshal.Alloc (allocaBytes) +import Foreign.Storable (pokeElemOff) +import System.IO (stdin, stdout, stderr) +import System.IO.OS + ( + withWindowsHandleReadingBiased, + withWindowsHandleWritingBiased + ) + +main :: IO () +main = withWindowsHandleReadingBiased stdin $ \ windowsStdin -> + withWindowsHandleWritingBiased stdout $ \ windowsStdout -> + withWindowsHandleWritingBiased stderr $ \ windowsStderr -> + do + withBuffer inputSizeApproximation $ \ bufferPtr -> do + inputSize <- win32_ReadFile windowsStdin + bufferPtr + inputSizeApproximation + Nothing + void $ win32_WriteFile windowsStdout + bufferPtr + inputSize + Nothing + withBuffer errorMsgSize $ \ bufferPtr -> do + zipWithM_ (pokeElemOff bufferPtr) + [0 ..] + (map (fromIntegral . ord) errorMsg) + void $ win32_WriteFile windowsStderr + bufferPtr + errorMsgSize + Nothing + where + + withBuffer :: DWORD -> (Ptr Word8 -> IO a) -> IO a + withBuffer = allocaBytes . fromIntegral + + inputSizeApproximation :: DWORD + inputSizeApproximation = 100 + + errorMsg :: String + errorMsg = "And every single door\n\ + \That I've walked through\n\ + \Brings me back, back here again\n" + + errorMsgSize :: DWORD + errorMsgSize = fromIntegral (length errorMsg) ===================================== libraries/base/tests/IO/osHandles002WindowsHandles.stderr ===================================== @@ -0,0 +1,3 @@ +And every single door +That I've walked through +Brings me back, back here again ===================================== libraries/base/tests/IO/osHandles002WindowsHandles.stdin ===================================== @@ -0,0 +1 @@ +We've got to get in to get out ===================================== libraries/base/tests/IO/osHandles002WindowsHandles.stdout ===================================== @@ -0,0 +1 @@ +We've got to get in to get out ===================================== libraries/ghc-internal/ghc-internal.cabal.in ===================================== @@ -328,6 +328,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,323 @@ +{-# 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 + preparation 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 user-defined preparation is performed. +-} + +{-| + 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#This subsection is just a dummy, whose purpose is to serve + as the target of the hyperlinks above. The real documentation of the caveats + is in the /Caveats/ subsection in the @base@ module @System.IO.OS@, which + re-exports the above operations. +-} ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -10048,6 +10048,17 @@ module System.IO.Error where userError :: GHC.Internal.Base.String -> IOError userErrorType :: IOErrorType +module System.IO.OS where + -- Safety: Safe + withFileDescriptorReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + module System.IO.Unsafe where -- Safety: Unsafe unsafeDupablePerformIO :: forall a. GHC.Internal.Types.IO a -> a ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -10086,6 +10086,17 @@ module System.IO.Error where userError :: GHC.Internal.Base.String -> IOError userErrorType :: IOErrorType +module System.IO.OS where + -- Safety: Safe + withFileDescriptorReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + module System.IO.Unsafe where -- Safety: Unsafe unsafeDupablePerformIO :: forall a. GHC.Internal.Types.IO a -> a ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -10328,6 +10328,17 @@ module System.IO.Error where userError :: GHC.Internal.Base.String -> IOError userErrorType :: IOErrorType +module System.IO.OS where + -- Safety: Safe + withFileDescriptorReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + module System.IO.Unsafe where -- Safety: Unsafe unsafeDupablePerformIO :: forall a. GHC.Internal.Types.IO a -> a ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -10048,6 +10048,17 @@ module System.IO.Error where userError :: GHC.Internal.Base.String -> IOError userErrorType :: IOErrorType +module System.IO.OS where + -- Safety: Safe + withFileDescriptorReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + module System.IO.Unsafe where -- Safety: Unsafe unsafeDupablePerformIO :: forall a. GHC.Internal.Types.IO a -> a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5957a8ad6e944e37d3be7ccf1b0776b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5957a8ad6e944e37d3be7ccf1b0776b… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] PPC NCG: Generate clear right insn at arch width
by Marge Bot (＠marge-bot) 27 Jan '26

27 Jan '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 56db94f7 by Peter Trommler at 2026-01-26T11:26:18+01:00 PPC NCG: Generate clear right insn at arch width The clear right immediate (clrrxi) is only available in word and doubleword width. Generate clrrxi instructions at architecture width for all MachOp widths. Fixes #24145 - - - - - 1 changed file: - compiler/GHC/CmmToAsm/PPC/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -539,7 +539,7 @@ getRegister' config platform (CmmMachOp mop [x]) -- unary MachOps CLRLI arch_fmt dst src1 (arch_bits - size) return (Any (intFormat to) code) -getRegister' _ _ (CmmMachOp mop [x, y]) -- dyadic PrimOps +getRegister' _ platform (CmmMachOp mop [x, y]) -- dyadic PrimOps = case mop of MO_F_Eq _ -> condFltReg EQQ x y MO_F_Ne _ -> condFltReg NE x y @@ -622,8 +622,9 @@ getRegister' _ _ (CmmMachOp mop [x, y]) -- dyadic PrimOps (src, srcCode) <- getSomeReg x let clear_mask = if imm == -4 then 2 else 3 fmt = intFormat rep + arch_fmt = intFormat (wordWidth platform) code dst = srcCode - `appOL` unitOL (CLRRI fmt dst src clear_mask) + `appOL` unitOL (CLRRI arch_fmt dst src clear_mask) return (Any fmt code) _ -> trivialCode rep False AND x y MO_Or rep -> trivialCode rep False OR x y View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56db94f791c6aae32798d82b74670c9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56db94f791c6aae32798d82b74670c9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26832] 8 commits: Export labelThread from Control.Concurrent
by Teo Camarasu (＠teo) 27 Jan '26

27 Jan '26

Teo Camarasu pushed to branch wip/T26832 at Glasgow Haskell Compiler / GHC Commits: 917ab8ff by Oleg Grenrus at 2026-01-23T10:52:55-05:00 Export labelThread from Control.Concurrent - - - - - 3f5e8d80 by Cheng Shao at 2026-01-23T10:53:37-05:00 ci: only push perf notes on master/release branches This patch fixes push_perf_notes logic in ci.sh to only push perf notes on master/release branches. We used to unconditionally push perf notes even in MRs, but the perf numbers in the wip branches wouldn't be used as baseline anyway, plus this is causing a space leak in the ghc-performance-notes repo. See #25317 for the perf notes repo size problem. Co-authored-by: Codex <codex(a)openai.com> - - - - - 414b9593 by Cheng Shao at 2026-01-24T07:11:51-05:00 ci: remove duplicate keys in .gitlab-ci.yml This patch removes accidentally duplicate keys in `.gitlab-ci.yml`. The YAML spec doesn't allow duplicate keys in the first place, and according to GitLab docs (https://docs.gitlab.com/ci/yaml/yaml_optimization/#anchors) the latest key overrides the earlier entries. - - - - - e5cb5491 by Cheng Shao at 2026-01-24T07:12:34-05:00 hadrian: drop obsolete configure/make builder logic for libffi This patch drops obsolete hadrian logic around `Configure libffiPath`/`Make libffiPath` builders, they are no longer needed after libffi-clib has landed. Closes #26815. - - - - - 2d160222 by Simon Hengel at 2026-01-24T07:13:17-05:00 Fix typo in roles.rst - - - - - baa080d7 by Teo Camarasu at 2026-01-27T10:15:41+00:00 ghc-internal: avoid depending on GHC.Internal.Exts This module is mostly just re-exports. It made sense as a user-facing module, but there's no good reason ghc-internal modules should depend on it and doing so linearises the module graph - - - - - 27b38796 by Teo Camarasu at 2026-01-27T10:51:31+00:00 ghc-internal: move considerAccessible to GHC.Internal.Magic Previously it lived in GHC.Internal.Exts, but it really deserves to live along with the other magic function, which are already re-exported from .Exts - - - - - 836851c8 by Teo Camarasu at 2026-01-27T10:51:31+00:00 ghc-internal: move maxTupleSize to GHC.Internal.Tuple This previously lived in GHC.Internal.Exts but a comment already said it should be moved to .Tuple - - - - - 27 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Builtin/Names.hs - docs/users_guide/exts/roles.rst - hadrian/src/Context.hs - hadrian/src/Settings/Builders/Configure.hs - hadrian/src/Settings/Builders/Make.hs - libraries/base/changelog.md - libraries/base/src/Control/Concurrent.hs - libraries/base/src/System/Timeout.hs - libraries/ghc-internal/src/GHC/Internal/Exts.hs - libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs - libraries/ghc-internal/src/GHC/Internal/JS/Foreign/Callback.hs - libraries/ghc-internal/src/GHC/Internal/JS/Prim.hs - libraries/ghc-internal/src/GHC/Internal/JS/Prim/Internal/Build.hs - libraries/ghc-internal/src/GHC/Internal/Magic.hs - libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs - libraries/ghc-internal/src/GHC/Internal/Tuple.hs - libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Exports.hs - libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Imports.hs - libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1050,10 +1050,6 @@ abi-test: optional: true dependencies: null image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora43:$DOCKER_REV" - rules: - - if: $CI_MERGE_REQUEST_ID - - if: '$CI_COMMIT_BRANCH == "master"' - - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/' tags: - x86_64-linux script: ===================================== .gitlab/ci.sh ===================================== @@ -493,6 +493,11 @@ function fetch_perf_notes() { } function push_perf_notes() { + if [[ "${CI_COMMIT_BRANCH:-}" != "master" ]] && [[ ! "${CI_COMMIT_BRANCH:-}" =~ ghc-[0-9]+\.[0-9]+ ]]; then + info "Perf notes are only pushed on master/release branches" + return + fi + if [[ -z "${TEST_ENV:-}" ]]; then return fi ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -1063,7 +1063,7 @@ alternativeClassKey = mkPreludeMiscIdUnique 754 -- Functions for GHC extensions considerAccessibleName :: Name -considerAccessibleName = varQual gHC_INTERNAL_EXTS (fsLit "considerAccessible") considerAccessibleIdKey +considerAccessibleName = varQual gHC_MAGIC (fsLit "considerAccessible") considerAccessibleIdKey -- Random GHC.Internal.Base functions fromStringName, otherwiseIdName, foldrName, buildName, augmentName, ===================================== docs/users_guide/exts/roles.rst ===================================== @@ -38,7 +38,7 @@ trouble. The way to identify such situations is to have *roles* assigned to type variables of datatypes, classes, and type synonyms. -Roles as implemented in GHC are a from a simplified version of the work +Roles as implemented in GHC are based on a simplified version of the work described in `Generative type abstraction and type-level computation <https://www.seas.upenn.edu/~sweirich/papers/popl163af-weirich.pdf>`__, published at POPL 2011. ===================================== hadrian/src/Context.hs ===================================== @@ -11,7 +11,7 @@ module Context ( pkgLibraryFile, pkgConfFile, pkgStampFile, resourcePath, objectPath, contextPath, getContextPath, libPath, distDir, distDynDir, - haddockStatsFilesDir, ensureConfigured, autogenPath, rtsContext, rtsBuildPath, libffiBuildPath + haddockStatsFilesDir, ensureConfigured, autogenPath, rtsContext, rtsBuildPath ) where import Base @@ -93,14 +93,6 @@ rtsContext stage = vanillaContext stage rts rtsBuildPath :: Stage -> Action FilePath rtsBuildPath stage = buildPath (rtsContext stage) --- | Build directory for in-tree 'libffi' library. -libffiBuildPath :: Stage -> Action FilePath -libffiBuildPath stage = buildPath $ Context - stage - libffi - (error "libffiBuildPath: way not set.") - (error "libffiBuildPath: inplace not set.") - pkgFileName :: Context -> Package -> String -> String -> Action FilePath pkgFileName context package prefix suffix = do pid <- pkgUnitId (stage context) package ===================================== hadrian/src/Settings/Builders/Configure.hs ===================================== @@ -8,8 +8,7 @@ configureBuilderArgs :: Args configureBuilderArgs = do stage <- getStage gmpPath <- expr (gmpBuildPath stage) - libffiPath <- expr (libffiBuildPath stage) - mconcat [ builder (Configure gmpPath) ? do + builder (Configure gmpPath) ? do targetArch <- queryTarget queryArch targetPlatform <- queryTarget targetPlatformTriple buildPlatform <- queryBuild targetPlatformTriple @@ -28,16 +27,3 @@ configureBuilderArgs = do -- option. <> [ "--enable-alloca=malloc-notreentrant" | targetArch == "wasm32" ] <> [ "--with-pic=yes" ] - - , builder (Configure libffiPath) ? do - top <- expr topDirectory - targetPlatform <- queryTarget targetPlatformTriple - way <- getWay - pure [ "--prefix=" ++ top -/- libffiPath -/- "inst" - , "--libdir=" ++ top -/- libffiPath -/- "inst/lib" - , "--enable-static=yes" - , "--enable-shared=" - ++ (if wayUnit Dynamic way - then "yes" - else "no") - , "--host=" ++ targetPlatform ] ] ===================================== hadrian/src/Settings/Builders/Make.hs ===================================== @@ -12,12 +12,8 @@ makeBuilderArgs = do threads <- shakeThreads <$> expr getShakeOptions stage <- getStage gmpPath <- expr (gmpBuildPath stage) - libffiPaths <- forM [Stage1, Stage2, Stage3 ] $ \s -> expr (libffiBuildPath s) let t = show $ max 4 (threads - 2) -- Don't use all Shake's threads - mconcat $ - (builder (Make gmpPath ) ? pure ["MAKEFLAGS=-j" ++ t]) : - [ builder (Make libffiPath) ? pure ["MAKEFLAGS=-j" ++ t, "install"] - | libffiPath <- libffiPaths ] + builder (Make gmpPath) ? pure ["MAKEFLAGS=-j" ++ t] validateBuilderArgs :: Args validateBuilderArgs = builder (Make "testsuite/tests") ? do ===================================== libraries/base/changelog.md ===================================== @@ -22,6 +22,7 @@ * `GHC.Conc.throwSTM` and `GHC.Conc.Sync.throwSTM` now carry a `HasCallStack` constraint and attach a `Backtrace` annotation to the thrown exception. ([GHC #25365](https://gitlab.haskell.org/ghc/ghc/-/issues/25365)) * `GHC.Conc.catchSTM` and `GHC.Conc.Sync.catchSTM` now attach `WhileHandling` annotation to exceptions thrown from the handler. ([GHC #25365](https://gitlab.haskell.org/ghc/ghc/-/issues/25365)) * Remove `GHC.JS.Prim.Internal.Build`, as per [CLC #329](https://github.com/haskell/core-libraries-committee/issues/329) + * Export `labelThread` from `Control.Concurrent`.([CLC proposal #376](https://github.com/haskell/core-libraries-committee/issues/376)) ## 4.22.0.0 *TBA* * Shipped with GHC 9.14.1 ===================================== libraries/base/src/Control/Concurrent.hs ===================================== @@ -82,6 +82,9 @@ module Control.Concurrent ( -- * Weak references to ThreadIds mkWeakThreadId, + -- * Thread debugging + labelThread, + -- * GHC's implementation of concurrency -- |This section describes features specific to GHC's ===================================== libraries/base/src/System/Timeout.hs ===================================== @@ -29,7 +29,6 @@ import GHC.Internal.Control.Exception (Exception(..), handleJust, bracket, asyncExceptionToException, asyncExceptionFromException) import GHC.Internal.Data.Unique (Unique, newUnique) -import GHC.Conc (labelThread) import Prelude -- $setup ===================================== libraries/ghc-internal/src/GHC/Internal/Exts.hs ===================================== @@ -321,10 +321,7 @@ import GHC.Internal.Data.Data import GHC.Internal.Data.Ord import qualified GHC.Internal.Debug.Trace import GHC.Internal.Unsafe.Coerce ( unsafeCoerce# ) -- just for re-export - --- XXX This should really be in Data.Tuple, where the definitions are -maxTupleSize :: Int -maxTupleSize = 64 +import GHC.Internal.Tuple (maxTupleSize) -- | 'the' ensures that all the elements of the list are identical -- and then returns that unique element @@ -444,27 +441,3 @@ resizeSmallMutableArray# arr0 szNew a s0 = (# s2, arr1 #) -> case copySmallMutableArray# arr0 0# arr1 0# szOld s2 of s3 -> (# s3, arr1 #) else (# s1, arr0 #) - --- | Semantically, @considerAccessible = True@. But it has special meaning --- to the pattern-match checker, which will never flag the clause in which --- 'considerAccessible' occurs as a guard as redundant or inaccessible. --- Example: --- --- > case (x, x) of --- > (True, True) -> 1 --- > (False, False) -> 2 --- > (True, False) -> 3 -- Warning: redundant --- --- The pattern-match checker will warn here that the third clause is redundant. --- It will stop doing so if the clause is adorned with 'considerAccessible': --- --- > case (x, x) of --- > (True, True) -> 1 --- > (False, False) -> 2 --- > (True, False) | considerAccessible -> 3 -- No warning --- --- Put 'considerAccessible' as the last statement of the guard to avoid get --- confusing results from the pattern-match checker, which takes \"consider --- accessible\" by word. -considerAccessible :: Bool -considerAccessible = True ===================================== libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs ===================================== @@ -75,9 +75,10 @@ import GHC.Internal.Int import GHC.Internal.Num import GHC.Internal.Real import GHC.Internal.Word -import GHC.Internal.Exts import GHC.Internal.Generics import GHC.Internal.Numeric +import GHC.Internal.Ptr +import GHC.Internal.Unsafe.Coerce import GHC.Internal.Stack (HasCallStack) ------------------------------------------------------------------------ ===================================== libraries/ghc-internal/src/GHC/Internal/JS/Foreign/Callback.hs ===================================== @@ -21,8 +21,6 @@ module GHC.Internal.JS.Foreign.Callback import GHC.Internal.JS.Prim -import qualified GHC.Internal.Exts as Exts - import GHC.Internal.Unsafe.Coerce import GHC.Internal.Base @@ -131,18 +129,18 @@ asyncCallback3 x = js_asyncCallbackApply 3 (unsafeCoerce x) -- ---------------------------------------------------------------------------- foreign import javascript unsafe "(($1, $2) => { return h$makeCallback(h$runSync, [$1], $2); })" - js_syncCallback :: Bool -> Exts.Any -> IO (Callback (IO b)) + js_syncCallback :: Bool -> Any -> IO (Callback (IO b)) foreign import javascript unsafe "(($1) => { return h$makeCallback(h$run, [], $1); })" - js_asyncCallback :: Exts.Any -> IO (Callback (IO b)) + js_asyncCallback :: Any -> IO (Callback (IO b)) foreign import javascript unsafe "(($1) => { return h$makeCallback(h$runSyncReturn, [false], $1); })" - js_syncCallbackReturn :: Exts.Any -> IO (Callback (IO JSVal)) + js_syncCallbackReturn :: Any -> IO (Callback (IO JSVal)) foreign import javascript unsafe "(($1, $2, $3) => { return h$makeCallbackApply($2, h$runSync, [$1], $3); })" - js_syncCallbackApply :: Bool -> Int -> Exts.Any -> IO (Callback b) + js_syncCallbackApply :: Bool -> Int -> Any -> IO (Callback b) foreign import javascript unsafe "(($1, $2) => { return h$makeCallbackApply($1, h$run, [], $2); })" - js_asyncCallbackApply :: Int -> Exts.Any -> IO (Callback b) + js_asyncCallbackApply :: Int -> Any -> IO (Callback b) foreign import javascript unsafe "(($1, $2) => { return h$makeCallbackApply($1, h$runSyncReturn, [false], $2); })" - js_syncCallbackApplyReturn :: Int -> Exts.Any -> IO (Callback b) + js_syncCallbackApplyReturn :: Int -> Any -> IO (Callback b) foreign import javascript unsafe "h$release" js_release :: Callback a -> IO () ===================================== libraries/ghc-internal/src/GHC/Internal/JS/Prim.hs ===================================== @@ -42,8 +42,8 @@ module GHC.Internal.JS.Prim ( JSVal(..), JSVal# import GHC.Internal.Unsafe.Coerce (unsafeCoerce) import GHC.Internal.Prim +import GHC.Internal.Types import qualified GHC.Internal.Exception as Ex -import qualified GHC.Internal.Exts as Exts import qualified GHC.Internal.CString as GHC import GHC.Internal.IO import GHC.Internal.Data.Bool @@ -78,15 +78,15 @@ instance Show JSException where #if defined(javascript_HOST_ARCH) {-# NOINLINE toIO #-} -toIO :: Exts.Any -> IO Exts.Any +toIO :: Any -> IO Any toIO x = pure x {-# NOINLINE resolve #-} -resolve :: JSVal# -> JSVal# -> Exts.Any -> IO () +resolve :: JSVal# -> JSVal# -> Any -> IO () resolve accept reject x = resolveIO accept reject (pure x) {-# NOINLINE resolveIO #-} -- used by the rts -resolveIO :: JSVal# -> JSVal# -> IO Exts.Any -> IO () +resolveIO :: JSVal# -> JSVal# -> IO Any -> IO () resolveIO accept reject x = (x >>= evaluate >>= js_callback_any accept) `catch` (\(e::Ex.SomeException) -> do @@ -260,16 +260,16 @@ seqList xs = go xs `seq` xs go [] = () foreign import javascript unsafe "h$toHsString" - js_fromJSString :: JSVal -> Exts.Any + js_fromJSString :: JSVal -> Any foreign import javascript unsafe "h$fromHsString" - js_toJSString :: Exts.Any -> JSVal + js_toJSString :: Any -> JSVal foreign import javascript unsafe "h$toHsListJSVal" - js_fromJSArray :: JSVal -> IO Exts.Any + js_fromJSArray :: JSVal -> IO Any foreign import javascript unsafe "h$fromHsListJSVal" - js_toJSArray :: Exts.Any -> IO JSVal + js_toJSArray :: Any -> IO JSVal foreign import javascript unsafe "(($1) => { return ($1 === null); })" js_isNull :: JSVal -> Bool @@ -287,10 +287,10 @@ foreign import javascript unsafe "(() => { return null; })" js_null :: JSVal foreign import javascript unsafe "(($1,$2) => { return $1[h$fromHsString($2)]; })" - js_getProp :: JSVal -> Exts.Any -> IO JSVal + js_getProp :: JSVal -> Any -> IO JSVal foreign import javascript unsafe "(($1,$2) => { return $1[h$fromHsString($2)]; })" - js_unsafeGetProp :: JSVal -> Exts.Any -> JSVal + js_unsafeGetProp :: JSVal -> Any -> JSVal foreign import javascript unsafe "(($1,$2) => { return $1[$2]; })" js_getProp' :: JSVal -> JSVal -> IO JSVal @@ -311,7 +311,7 @@ foreign import javascript unsafe "(($1_1, $1_2) => { return h$decodeUtf8z($1_1,$ js_unsafeUnpackJSStringUtf8## :: Addr# -> JSVal# foreign import javascript unsafe "(($1, $2) => { return $1($2); })" - js_callback_any :: JSVal# -> Exts.Any -> IO () + js_callback_any :: JSVal# -> Any -> IO () foreign import javascript unsafe "(($1, $2) => { return $1($2); })" js_callback_jsval :: JSVal# -> JSVal -> IO () ===================================== libraries/ghc-internal/src/GHC/Internal/JS/Prim/Internal/Build.hs ===================================== @@ -145,7 +145,6 @@ module GHC.Internal.JS.Prim.Internal.Build ) where import GHC.Internal.JS.Prim -import GHC.Internal.Exts import GHC.Internal.IO import GHC.Internal.Unsafe.Coerce import GHC.Internal.Base ===================================== libraries/ghc-internal/src/GHC/Internal/Magic.hs ===================================== @@ -24,7 +24,7 @@ -- ----------------------------------------------------------------------------- -module GHC.Internal.Magic ( inline, noinline, lazy, oneShot, runRW#, DataToTag(..) ) where +module GHC.Internal.Magic ( inline, noinline, lazy, oneShot, runRW#, DataToTag(..), considerAccessible ) where -------------------------------------------------- -- See Note [magicIds] in GHC.Types.Id.Make @@ -34,7 +34,7 @@ module GHC.Internal.Magic ( inline, noinline, lazy, oneShot, runRW#, DataToTag(. -- because TYPE is not exported by the source Haskell module generated by -- genprimops which Haddock will typecheck (#15935). import GHC.Internal.Prim (State#, realWorld#, RealWorld, Int#) -import GHC.Internal.Types (RuntimeRep(BoxedRep), TYPE, Levity, Constraint) +import GHC.Internal.Types (RuntimeRep(BoxedRep), TYPE, Levity, Constraint, Bool(True)) -- | The call @inline f@ arranges that @f@ is inlined, regardless of -- its size. More precisely, the call @inline f@ rewrites to the @@ -137,3 +137,27 @@ type DataToTag :: forall {lev :: Levity}. TYPE (BoxedRep lev) -> Constraint -- So it does not get its own Unsafe module, unlike WithDict. class DataToTag a where dataToTag# :: a -> Int# + +-- | Semantically, @considerAccessible = True@. But it has special meaning +-- to the pattern-match checker, which will never flag the clause in which +-- 'considerAccessible' occurs as a guard as redundant or inaccessible. +-- Example: +-- +-- > case (x, x) of +-- > (True, True) -> 1 +-- > (False, False) -> 2 +-- > (True, False) -> 3 -- Warning: redundant +-- +-- The pattern-match checker will warn here that the third clause is redundant. +-- It will stop doing so if the clause is adorned with 'considerAccessible': +-- +-- > case (x, x) of +-- > (True, True) -> 1 +-- > (False, False) -> 2 +-- > (True, False) | considerAccessible -> 3 -- No warning +-- +-- Put 'considerAccessible' as the last statement of the guard to avoid get +-- confusing results from the pattern-match checker, which takes \"consider +-- accessible\" by word. +considerAccessible :: Bool +considerAccessible = True ===================================== libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs ===================================== @@ -40,8 +40,8 @@ import GHC.Internal.Data.List import GHC.Internal.Data.Tuple import GHC.Internal.Foreign.Ptr import GHC.Internal.Foreign.Storable -import GHC.Internal.Exts import GHC.Internal.Unsafe.Coerce +import GHC.Internal.Ptr import GHC.Internal.ClosureTypes import GHC.Internal.Heap.Closures ===================================== libraries/ghc-internal/src/GHC/Internal/Tuple.hs ===================================== @@ -27,10 +27,11 @@ module GHC.Internal.Tuple ( Tuple40(..), Tuple41(..), Tuple42(..), Tuple43(..), Tuple44(..), Tuple45(..), Tuple46(..), Tuple47(..), Tuple48(..), Tuple49(..), Tuple50(..), Tuple51(..), Tuple52(..), Tuple53(..), Tuple54(..), Tuple55(..), Tuple56(..), Tuple57(..), Tuple58(..), Tuple59(..), Tuple60(..), Tuple61(..), Tuple62(..), Tuple63(..), Tuple64(..), + maxTupleSize, ) where -- See W1 of Note [Tracking dependencies on primitives] in GHC.Internal.Base -import GHC.Internal.Types () +import GHC.Internal.Types (Int) default () -- Double and Integer aren't available yet @@ -598,3 +599,6 @@ data Tuple64 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 g2 h2 i2 j2 k2 l2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2,j2,k2,l2) + +maxTupleSize :: Int +maxTupleSize = 64 ===================================== libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Exports.hs ===================================== @@ -32,7 +32,6 @@ module GHC.Internal.Wasm.Prim.Exports ( import GHC.Internal.Base import GHC.Internal.Exception.Type -import GHC.Internal.Exts import GHC.Internal.IO import GHC.Internal.IORef import GHC.Internal.Int ===================================== libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Imports.hs ===================================== @@ -30,7 +30,6 @@ module GHC.Internal.Wasm.Prim.Imports ( import GHC.Internal.Base import GHC.Internal.Exception -import GHC.Internal.Exts import GHC.Internal.IO.Unsafe import GHC.Internal.Stable import GHC.Internal.Wasm.Prim.Types ===================================== libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs ===================================== @@ -20,7 +20,6 @@ module GHC.Internal.Wasm.Prim.Types ( import GHC.Internal.Base import GHC.Internal.Exception.Type -import GHC.Internal.Exts import GHC.Internal.Foreign.C.String.Encoding import GHC.Internal.ForeignPtr import GHC.Internal.IO ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -120,6 +120,7 @@ module Control.Concurrent where isCurrentThreadBound :: GHC.Internal.Types.IO GHC.Internal.Types.Bool isEmptyMVar :: forall a. MVar a -> GHC.Internal.Types.IO GHC.Internal.Types.Bool killThread :: ThreadId -> GHC.Internal.Types.IO () + labelThread :: ThreadId -> GHC.Internal.Base.String -> GHC.Internal.Types.IO () mkWeakMVar :: forall a. MVar a -> GHC.Internal.Types.IO () -> GHC.Internal.Types.IO (GHC.Internal.Weak.Weak (MVar a)) mkWeakThreadId :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Weak.Weak ThreadId) modifyMVar :: forall a b. MVar a -> (a -> GHC.Internal.Types.IO (a, b)) -> GHC.Internal.Types.IO b ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -120,6 +120,7 @@ module Control.Concurrent where isCurrentThreadBound :: GHC.Internal.Types.IO GHC.Internal.Types.Bool isEmptyMVar :: forall a. MVar a -> GHC.Internal.Types.IO GHC.Internal.Types.Bool killThread :: ThreadId -> GHC.Internal.Types.IO () + labelThread :: ThreadId -> GHC.Internal.Base.String -> GHC.Internal.Types.IO () mkWeakMVar :: forall a. MVar a -> GHC.Internal.Types.IO () -> GHC.Internal.Types.IO (GHC.Internal.Weak.Weak (MVar a)) mkWeakThreadId :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Weak.Weak ThreadId) modifyMVar :: forall a b. MVar a -> (a -> GHC.Internal.Types.IO (a, b)) -> GHC.Internal.Types.IO b ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -120,6 +120,7 @@ module Control.Concurrent where isCurrentThreadBound :: GHC.Internal.Types.IO GHC.Internal.Types.Bool isEmptyMVar :: forall a. MVar a -> GHC.Internal.Types.IO GHC.Internal.Types.Bool killThread :: ThreadId -> GHC.Internal.Types.IO () + labelThread :: ThreadId -> GHC.Internal.Base.String -> GHC.Internal.Types.IO () mkWeakMVar :: forall a. MVar a -> GHC.Internal.Types.IO () -> GHC.Internal.Types.IO (GHC.Internal.Weak.Weak (MVar a)) mkWeakThreadId :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Weak.Weak ThreadId) modifyMVar :: forall a b. MVar a -> (a -> GHC.Internal.Types.IO (a, b)) -> GHC.Internal.Types.IO b ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -120,6 +120,7 @@ module Control.Concurrent where isCurrentThreadBound :: GHC.Internal.Types.IO GHC.Internal.Types.Bool isEmptyMVar :: forall a. MVar a -> GHC.Internal.Types.IO GHC.Internal.Types.Bool killThread :: ThreadId -> GHC.Internal.Types.IO () + labelThread :: ThreadId -> GHC.Internal.Base.String -> GHC.Internal.Types.IO () mkWeakMVar :: forall a. MVar a -> GHC.Internal.Types.IO () -> GHC.Internal.Types.IO (GHC.Internal.Weak.Weak (MVar a)) mkWeakThreadId :: ThreadId -> GHC.Internal.Types.IO (GHC.Internal.Weak.Weak ThreadId) modifyMVar :: forall a b. MVar a -> (a -> GHC.Internal.Types.IO (a, b)) -> GHC.Internal.Types.IO b ===================================== testsuite/tests/interface-stability/ghc-experimental-exports.stdout ===================================== @@ -4453,6 +4453,7 @@ module Data.Tuple.Experimental where type Unit# :: GHC.Internal.Types.ZeroBitType data Unit# = ... getSolo :: forall a. Solo a -> a + maxTupleSize :: GHC.Internal.Types.Int module GHC.Exception.Backtrace.Experimental where -- Safety: None @@ -11044,6 +11045,7 @@ module Prelude.Experimental where type Unit# :: GHC.Internal.Types.ZeroBitType data Unit# = ... getSolo :: forall a. Solo a -> a + maxTupleSize :: GHC.Internal.Types.Int module System.Mem.Experimental where -- Safety: None ===================================== testsuite/tests/interface-stability/ghc-prim-exports.stdout ===================================== @@ -1232,6 +1232,7 @@ module GHC.Magic where class DataToTag a where dataToTag# :: a -> GHC.Internal.Prim.Int# {-# MINIMAL dataToTag# #-} + considerAccessible :: GHC.Internal.Types.Bool inline :: forall a. a -> a lazy :: forall a. a -> a noinline :: forall a. a -> a @@ -3891,6 +3892,7 @@ module GHC.Tuple where type Unit :: * data Unit = () getSolo :: forall a. Solo a -> a + maxTupleSize :: GHC.Internal.Types.Int module GHC.Types where -- Safety: None View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f5cee2076e8b14fcce7798717d6c60… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f5cee2076e8b14fcce7798717d6c60… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26834] 2 commits: ghc-internal: refine List imports
by Teo Camarasu (＠teo) 27 Jan '26

27 Jan '26

Teo Camarasu pushed to branch wip/T26834 at Glasgow Haskell Compiler / GHC Commits: fabb5297 by Teo Camarasu at 2026-01-27T09:28:31+00:00 ghc-internal: refine List imports - - - - - 87d4f2db by Teo Camarasu at 2026-01-27T09:28:31+00:00 Move MonadFix Identity into Monad.Fix - - - - - 16 changed files: - libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs - libraries/ghc-internal/src/GHC/Internal/Control/Monad/Zip.hs - libraries/ghc-internal/src/GHC/Internal/Data/Data.hs - libraries/ghc-internal/src/GHC/Internal/Data/Functor/Identity.hs - libraries/ghc-internal/src/GHC/Internal/Data/List/NonEmpty.hs - libraries/ghc-internal/src/GHC/Internal/Data/String.hs - libraries/ghc-internal/src/GHC/Internal/Data/Version.hs - libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc - libraries/ghc-internal/src/GHC/Internal/ExecutionStack/Internal.hsc - libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage.hs - libraries/ghc-internal/src/GHC/Internal/ResponseFile.hs - libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs - libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc - libraries/ghc-internal/src/GHC/Internal/System/Environment/ExecutablePath.hsc - libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs - libraries/ghc-internal/src/GHC/Internal/Windows.hs Changes: ===================================== libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs ===================================== @@ -40,6 +40,7 @@ import GHC.Internal.Generics import GHC.Internal.List ( head, drop ) import GHC.Internal.Control.Monad.ST.Imp import GHC.Internal.System.IO +import GHC.Internal.Data.Functor.Identity (Identity(..)) -- | Monads having fixed points with a \'knot-tying\' semantics. -- Instances of 'MonadFix' should satisfy the following laws: @@ -171,3 +172,8 @@ instance (MonadFix f, MonadFix g) => MonadFix (f :*: g) where -- | @since base-4.12.0.0 instance MonadFix Down where mfix f = Down (fix (getDown . f)) + + +-- | @since base-4.8.0.0 +instance MonadFix Identity where + mfix f = Identity (fix (runIdentity . f)) ===================================== libraries/ghc-internal/src/GHC/Internal/Control/Monad/Zip.hs ===================================== @@ -28,7 +28,7 @@ import GHC.Internal.Data.Proxy --import qualified Data.List.NonEmpty as NE import GHC.Internal.Generics import qualified GHC.Internal.Data.List.NonEmpty as NE -import qualified GHC.Internal.Data.List as List +import qualified GHC.Internal.List as List import GHC.Internal.Data.Maybe import GHC.Internal.Data.Tuple --import Prelude ===================================== libraries/ghc-internal/src/GHC/Internal/Data/Data.hs ===================================== @@ -117,7 +117,7 @@ import GHC.Internal.Data.Maybe import GHC.Internal.Data.Monoid import GHC.Internal.Data.NonEmpty ( NonEmpty(..) ) import GHC.Internal.Data.Ord -import GHC.Internal.Data.List (findIndex) +import GHC.Internal.Data.OldList (findIndex) import GHC.Internal.Data.Typeable import GHC.Internal.Data.Version( Version(..) ) import GHC.Internal.Base hiding (Any, IntRep, FloatRep, NonEmpty(..)) ===================================== libraries/ghc-internal/src/GHC/Internal/Data/Functor/Identity.hs ===================================== @@ -33,7 +33,6 @@ module GHC.Internal.Data.Functor.Identity ( Identity(..), ) where -import GHC.Internal.Control.Monad.Fix import GHC.Internal.Data.Bits (Bits, FiniteBits) import GHC.Internal.Data.Coerce import GHC.Internal.Data.Foldable @@ -143,7 +142,3 @@ instance Applicative Identity where -- | @since base-4.8.0.0 instance Monad Identity where m >>= k = k (runIdentity m) - --- | @since base-4.8.0.0 -instance MonadFix Identity where - mfix f = Identity (fix (runIdentity . f)) ===================================== libraries/ghc-internal/src/GHC/Internal/Data/List/NonEmpty.hs ===================================== @@ -8,7 +8,7 @@ module GHC.Internal.Data.List.NonEmpty ) where import GHC.Internal.Data.NonEmpty (NonEmpty (..), map) -import qualified GHC.Internal.Data.List as List +import qualified GHC.Internal.List as List -- | The 'zip' function takes two streams and returns a stream of -- corresponding pairs. ===================================== libraries/ghc-internal/src/GHC/Internal/Data/String.hs ===================================== @@ -35,7 +35,7 @@ module GHC.Internal.Data.String ( import GHC.Internal.Base import GHC.Internal.Data.Functor.Const (Const (Const)) import GHC.Internal.Data.Functor.Identity (Identity (Identity)) -import GHC.Internal.Data.List (lines, words, unlines, unwords) +import GHC.Internal.Data.OldList (lines, words, unlines, unwords) -- | `IsString` is used in combination with the @-XOverloadedStrings@ -- language extension to convert the literals to different string types. ===================================== libraries/ghc-internal/src/GHC/Internal/Data/Version.hs ===================================== @@ -40,7 +40,7 @@ import GHC.Internal.Data.Functor ( Functor(..) ) import GHC.Internal.Data.Bool ( (&&) ) import GHC.Internal.Data.Eq import GHC.Internal.Int ( Int ) -import GHC.Internal.Data.List ( map, sort, concat, concatMap, intersperse, (++) ) +import GHC.Internal.Data.OldList ( map, sort, concat, concatMap, intersperse, (++) ) import GHC.Internal.Data.Ord import GHC.Internal.Data.String ( String ) import GHC.Internal.Base ( Applicative(..) ) ===================================== libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc ===================================== @@ -103,7 +103,7 @@ import GHC.Internal.IORef import GHC.Internal.Maybe import GHC.Internal.Ptr import GHC.Internal.Word -import GHC.Internal.Data.OldList (deleteBy) +import GHC.Internal.List (deleteBy) import qualified GHC.Internal.Event.Array as A import GHC.Internal.Base import GHC.Internal.Conc.Bound ===================================== libraries/ghc-internal/src/GHC/Internal/ExecutionStack/Internal.hsc ===================================== @@ -39,7 +39,7 @@ module GHC.Internal.ExecutionStack.Internal ( import GHC.Internal.Data.Functor import GHC.Internal.Data.Maybe -import GHC.Internal.Data.List (reverse, null) +import GHC.Internal.List (reverse, null) import GHC.Internal.Word import GHC.Internal.Foreign.C.Types import GHC.Internal.Foreign.C.String (peekCString, CString) ===================================== libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage.hs ===================================== @@ -30,7 +30,7 @@ import GHC.Internal.IO.Encoding.Types import GHC.Internal.IO.Buffer import GHC.Internal.Data.Bits import GHC.Internal.Data.Maybe -import GHC.Internal.Data.OldList (lookup) +import GHC.Internal.List (lookup) import qualified GHC.Internal.IO.Encoding.CodePage.API as API import GHC.Internal.IO.Encoding.CodePage.Table ===================================== libraries/ghc-internal/src/GHC/Internal/ResponseFile.hs ===================================== @@ -28,7 +28,7 @@ import GHC.Internal.Control.Exception import GHC.Internal.Data.Foldable (Foldable(..)) import GHC.Internal.Base import GHC.Internal.Unicode (isSpace) -import GHC.Internal.Data.List (filter, unlines, concat, reverse) +import GHC.Internal.Data.OldList (filter, unlines, concat, reverse) import GHC.Internal.Text.Show (show) import GHC.Internal.System.Environment (getArgs) import GHC.Internal.System.Exit (exitFailure) ===================================== libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs ===================================== @@ -36,7 +36,7 @@ import GHC.Internal.Num import GHC.Internal.Data.Bits import GHC.Internal.Data.Functor import GHC.Internal.Data.Maybe (catMaybes) -import GHC.Internal.Data.List +import GHC.Internal.List import GHC.Internal.Data.Tuple import GHC.Internal.Foreign.Ptr import GHC.Internal.Foreign.Storable ===================================== libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc ===================================== @@ -40,14 +40,14 @@ module GHC.Internal.System.Environment.Blank ) where import GHC.Internal.Data.Functor -import GHC.Internal.Data.List (elem, null, takeWhile) +import GHC.Internal.List (elem, null, takeWhile) import GHC.Internal.Foreign.C.String import GHC.Internal.Base #if defined(mingw32_HOST_OS) import GHC.Internal.Foreign.Ptr import GHC.Internal.Windows import GHC.Internal.Control.Monad -import GHC.Internal.Data.List (lookup) +import GHC.Internal.List (lookup) #else import GHC.Internal.Foreign.C.Error import GHC.Internal.Foreign.C.Types ===================================== libraries/ghc-internal/src/GHC/Internal/System/Environment/ExecutablePath.hsc ===================================== @@ -53,7 +53,7 @@ import GHC.Internal.System.IO.Error (isDoesNotExistError) import GHC.Internal.System.Posix.Internals #elif defined(linux_HOST_OS) || defined(gnu_HOST_OS) import GHC.Internal.Data.Functor -import GHC.Internal.Data.List (isSuffixOf) +import GHC.Internal.Data.OldList (isSuffixOf) import GHC.Internal.Foreign.C.Types import GHC.Internal.Foreign.C.Error import GHC.Internal.Foreign.C.String @@ -85,7 +85,7 @@ import GHC.Internal.System.Posix.Internals import GHC.Internal.Control.Exception import GHC.Internal.Control.Monad.Fail import GHC.Internal.Data.Functor -import GHC.Internal.Data.List (isPrefixOf, drop) +import GHC.Internal.Data.OldList (isPrefixOf, drop) import GHC.Internal.Word import GHC.Internal.Foreign.C.String import GHC.Internal.Foreign.Marshal.Array ===================================== libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs ===================================== @@ -70,7 +70,7 @@ import GHC.Internal.Foreign.Storable import qualified GHC.Internal.Foreign.C.String.Encoding as GHC #else import GHC.Internal.Int -import GHC.Internal.Data.OldList (elem) +import GHC.Internal.List (elem) #endif -- --------------------------------------------------------------------------- ===================================== libraries/ghc-internal/src/GHC/Internal/Windows.hs ===================================== @@ -80,7 +80,7 @@ module GHC.Internal.Windows ( import GHC.Internal.Data.Bits (finiteBitSize, shiftL, shiftR, (.|.), (.&.)) import GHC.Internal.Unicode (isSpace) -import GHC.Internal.Data.OldList +import GHC.Internal.List import GHC.Internal.Data.Maybe import GHC.Internal.Word import GHC.Internal.Int View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2a1f0bdcfc782163b20cb5ce6d5c91… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2a1f0bdcfc782163b20cb5ce6d5c91… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/andreask/ticked_joins] simplRec
by sheaf (＠sheaf) 27 Jan '26

27 Jan '26

sheaf pushed to branch wip/andreask/ticked_joins at Glasgow Haskell Compiler / GHC Commits: e3242e37 by sheaf at 2026-01-27T10:34:13+01:00 simplRec - - - - - 1 changed file: - compiler/GHC/Core/Opt/Simplify/Iteration.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -2077,7 +2077,7 @@ simplNonRecJoinPoint env bndr rhs body cont -- and wrap wrap_cont around the whole thing ; let (mult, res_ty) -- SLD TODO - | Just QuasiJoinPoint <- occInfoJoinPointType_maybe (idOccInfo bndr) + | Just QuasiJoinPoint <- joinId_maybe bndr = (idMult bndr, peelJoinResTy (idJoinArity bndr) $ substTy env (idType bndr)) | otherwise = (contHoleScaling cont, contResultType cont) @@ -2102,7 +2102,7 @@ simplRecJoinPoint env pairs body cont (mult, res_ty) -- SLD TODO | [b] <- bndrs - , Just QuasiJoinPoint <- occInfoJoinPointType_maybe (idOccInfo b) + , Just QuasiJoinPoint <- joinId_maybe b = (idMult b, peelJoinResTy (idJoinArity b) $ substTy env (idType b)) | otherwise = (contHoleScaling cont, contResultType cont) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e3242e3706608000c4b6f79eff6c947… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e3242e3706608000c4b6f79eff6c947… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Add operations for obtaining operating-system handles
by Marge Bot (＠marge-bot) 27 Jan '26

27 Jan '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1fc0bd6a by Wolfgang Jeltsch at 2026-01-27T00:30:20-05:00 Add operations for obtaining operating-system handles This contribution implements CLC proposal #369. It adds operations for obtaining POSIX file descriptors and Windows handles that underlie Haskell handles. Those operating system handles can also be obtained without such additional operations, but this is more involved and, more importantly, requires using internals. - - - - - bce2a8fa by Greg Steuck at 2026-01-27T00:30:29-05:00 Move flags to precede patterns for grep and read files directly This makes the tests pass with non-GNU (i.e. POSIX-complicant) tools. There's no reason to use cat and pipe where direct file argument works. - - - - - 25 changed files: - libraries/base/base.cabal.in - libraries/base/changelog.md - + libraries/base/src/System/IO/OS.hs - libraries/base/tests/IO/all.T - + libraries/base/tests/IO/osHandles001FileDescriptors.hs - + libraries/base/tests/IO/osHandles001FileDescriptors.stdout - + libraries/base/tests/IO/osHandles001WindowsHandles.hs - + libraries/base/tests/IO/osHandles001WindowsHandles.stdout - + libraries/base/tests/IO/osHandles002FileDescriptors.hs - + libraries/base/tests/IO/osHandles002FileDescriptors.stderr - + libraries/base/tests/IO/osHandles002FileDescriptors.stdin - + libraries/base/tests/IO/osHandles002FileDescriptors.stdout - + libraries/base/tests/IO/osHandles002WindowsHandles.hs - + libraries/base/tests/IO/osHandles002WindowsHandles.stderr - + libraries/base/tests/IO/osHandles002WindowsHandles.stdin - + libraries/base/tests/IO/osHandles002WindowsHandles.stdout - libraries/base/tests/perf/Makefile - libraries/ghc-internal/ghc-internal.cabal.in - + libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs - testsuite/tests/driver/T16318/Makefile - testsuite/tests/driver/T18125/Makefile - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 Changes: ===================================== libraries/base/base.cabal.in ===================================== @@ -255,6 +255,7 @@ Library , System.Exit , System.IO , System.IO.Error + , System.IO.OS , System.Mem , System.Mem.StableName , System.Posix.Internals ===================================== libraries/base/changelog.md ===================================== @@ -23,6 +23,7 @@ * `GHC.Conc.catchSTM` and `GHC.Conc.Sync.catchSTM` now attach `WhileHandling` annotation to exceptions thrown from the handler. ([GHC #25365](https://gitlab.haskell.org/ghc/ghc/-/issues/25365)) * Remove `GHC.JS.Prim.Internal.Build`, as per [CLC #329](https://github.com/haskell/core-libraries-committee/issues/329) * Export `labelThread` from `Control.Concurrent`.([CLC proposal #376](https://github.com/haskell/core-libraries-committee/issues/376)) + * Add a new module `System.IO.OS` with operations for obtaining operating-system handles (file descriptors, Windows handles). ([CLC proposal #369](https://github.com/haskell/core-libraries-committee/issues/369)) ## 4.22.0.0 *TBA* * Shipped with GHC 9.14.1 ===================================== libraries/base/src/System/IO/OS.hs ===================================== @@ -0,0 +1,62 @@ +{-# LANGUAGE Safe #-} + +{-| + This module bridges between Haskell handles and underlying operating-system + features. +-} +module 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.System.IO.OS + ( + withFileDescriptorReadingBiased, + withFileDescriptorWritingBiased, + withWindowsHandleReadingBiased, + withWindowsHandleWritingBiased, + withFileDescriptorReadingBiasedRaw, + withFileDescriptorWritingBiasedRaw, + withWindowsHandleReadingBiasedRaw, + withWindowsHandleWritingBiasedRaw + ) + +-- ** 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. +-} ===================================== libraries/base/tests/IO/all.T ===================================== @@ -186,3 +186,15 @@ test('T17912', [only_ways(['threaded1']), when(opsys('mingw32'),expect_broken(1) test('T18832', only_ways(['threaded1']), compile_and_run, ['']) test('mkdirExists', [exit_code(1), when(opsys('mingw32'), ignore_stderr)], compile_and_run, ['']) + +test('osHandles001FileDescriptors', omit_ways(['winio', 'winio_threaded']), compile_and_run, ['']) +test('osHandles001WindowsHandles', only_ways(['winio', 'winio_threaded']), compile_and_run, ['']) +test('osHandles002FileDescriptors', [when(opsys('mingw32'), skip), when(arch('javascript'), skip)], compile_and_run, ['']) +test('osHandles002WindowsHandles', only_ways(['winio', 'winio_threaded']), compile_and_run, ['']) +# It would be good to let `osHandles002FileDescriptors` run also on +# Windows with the file-descriptor-based I/O manager. However, this +# test, as it is currently implemented, requires the `unix` package. +# That said, `UCRT.DLL`, which is used by GHC-generated Windows +# executables, emulates part of POSIX, enough for this test. As a +# result, this test could be generalized to also supporting Windows, but +# this would likely involve creating bindings to C code. ===================================== libraries/base/tests/IO/osHandles001FileDescriptors.hs ===================================== @@ -0,0 +1,23 @@ +{-# LANGUAGE TypeApplications #-} + +import Control.Monad (mapM_) +import Control.Exception (SomeException, try) +import System.IO (stdin, stdout, stderr) +import System.IO.OS + ( + withFileDescriptorReadingBiasedRaw, + withFileDescriptorWritingBiasedRaw, + withWindowsHandleReadingBiasedRaw, + withWindowsHandleWritingBiasedRaw + ) + +main :: IO () +main = mapM_ ((>>= print) . try @SomeException) $ + [ + withFileDescriptorReadingBiasedRaw stdin (return . show), + withFileDescriptorWritingBiasedRaw stdout (return . show), + withFileDescriptorWritingBiasedRaw stderr (return . show), + withWindowsHandleReadingBiasedRaw stdin (return . const "_"), + withWindowsHandleWritingBiasedRaw stdout (return . const "_"), + withWindowsHandleWritingBiasedRaw stderr (return . const "_") + ] ===================================== libraries/base/tests/IO/osHandles001FileDescriptors.stdout ===================================== @@ -0,0 +1,6 @@ +Right "0" +Right "1" +Right "2" +Left <stdin>: withWindowsHandleReadingBiasedRaw: inappropriate type (handle does not use Windows handles) +Left <stdout>: withWindowsHandleWritingBiasedRaw: inappropriate type (handle does not use Windows handles) +Left <stderr>: withWindowsHandleWritingBiasedRaw: inappropriate type (handle does not use Windows handles) ===================================== libraries/base/tests/IO/osHandles001WindowsHandles.hs ===================================== @@ -0,0 +1,23 @@ +{-# LANGUAGE TypeApplications #-} + +import Control.Monad (mapM_) +import Control.Exception (SomeException, try) +import System.IO (stdin, stdout, stderr) +import System.IO.OS + ( + withFileDescriptorReadingBiasedRaw, + withFileDescriptorWritingBiasedRaw, + withWindowsHandleReadingBiasedRaw, + withWindowsHandleWritingBiasedRaw + ) + +main :: IO () +main = mapM_ ((>>= print) . try @SomeException) $ + [ + withFileDescriptorReadingBiasedRaw stdin (return . show), + withFileDescriptorWritingBiasedRaw stdout (return . show), + withFileDescriptorWritingBiasedRaw stderr (return . show), + withWindowsHandleReadingBiasedRaw stdin (return . const "_"), + withWindowsHandleWritingBiasedRaw stdout (return . const "_"), + withWindowsHandleWritingBiasedRaw stderr (return . const "_") + ] ===================================== libraries/base/tests/IO/osHandles001WindowsHandles.stdout ===================================== @@ -0,0 +1,6 @@ +Left <stdin>: withFileDescriptorReadingBiasedRaw: inappropriate type (handle does not use file descriptors) +Left <stdout>: withFileDescriptorWritingBiasedRaw: inappropriate type (handle does not use file descriptors) +Left <stderr>: withFileDescriptorWritingBiasedRaw: inappropriate type (handle does not use file descriptors) +Right "_" +Right "_" +Right "_" ===================================== libraries/base/tests/IO/osHandles002FileDescriptors.hs ===================================== @@ -0,0 +1,28 @@ +import Data.Functor (void) +import Data.ByteString.Char8 (pack) +import System.Posix.Types (Fd (Fd), ByteCount) +import System.Posix.IO.ByteString (fdRead, fdWrite) +import System.IO (stdin, stdout, stderr) +import System.IO.OS + ( + withFileDescriptorReadingBiased, + withFileDescriptorWritingBiased + ) + +main :: IO () +main = withFileDescriptorReadingBiased stdin $ \ stdinFD -> + withFileDescriptorWritingBiased stdout $ \ stdoutFD -> + withFileDescriptorWritingBiased stderr $ \ stderrFD -> + do + regularMsg <- fdRead (Fd stdinFD) inputSizeApproximation + void $ fdWrite (Fd stdoutFD) regularMsg + void $ fdWrite (Fd stderrFD) (pack errorMsg) + where + + inputSizeApproximation :: ByteCount + inputSizeApproximation = 100 + + errorMsg :: String + errorMsg = "And every single door\n\ + \That I've walked through\n\ + \Brings me back, back here again\n" ===================================== libraries/base/tests/IO/osHandles002FileDescriptors.stderr ===================================== @@ -0,0 +1,3 @@ +And every single door +That I've walked through +Brings me back, back here again ===================================== libraries/base/tests/IO/osHandles002FileDescriptors.stdin ===================================== @@ -0,0 +1 @@ +We've got to get in to get out ===================================== libraries/base/tests/IO/osHandles002FileDescriptors.stdout ===================================== @@ -0,0 +1 @@ +We've got to get in to get out ===================================== libraries/base/tests/IO/osHandles002WindowsHandles.hs ===================================== @@ -0,0 +1,49 @@ +import Control.Monad (zipWithM_) +import Data.Functor (void) +import Data.Char (ord) +import Foreign.Marshal.Alloc (allocaBytes) +import Foreign.Storable (pokeElemOff) +import System.IO (stdin, stdout, stderr) +import System.IO.OS + ( + withWindowsHandleReadingBiased, + withWindowsHandleWritingBiased + ) + +main :: IO () +main = withWindowsHandleReadingBiased stdin $ \ windowsStdin -> + withWindowsHandleWritingBiased stdout $ \ windowsStdout -> + withWindowsHandleWritingBiased stderr $ \ windowsStderr -> + do + withBuffer inputSizeApproximation $ \ bufferPtr -> do + inputSize <- win32_ReadFile windowsStdin + bufferPtr + inputSizeApproximation + Nothing + void $ win32_WriteFile windowsStdout + bufferPtr + inputSize + Nothing + withBuffer errorMsgSize $ \ bufferPtr -> do + zipWithM_ (pokeElemOff bufferPtr) + [0 ..] + (map (fromIntegral . ord) errorMsg) + void $ win32_WriteFile windowsStderr + bufferPtr + errorMsgSize + Nothing + where + + withBuffer :: DWORD -> (Ptr Word8 -> IO a) -> IO a + withBuffer = allocaBytes . fromIntegral + + inputSizeApproximation :: DWORD + inputSizeApproximation = 100 + + errorMsg :: String + errorMsg = "And every single door\n\ + \That I've walked through\n\ + \Brings me back, back here again\n" + + errorMsgSize :: DWORD + errorMsgSize = fromIntegral (length errorMsg) ===================================== libraries/base/tests/IO/osHandles002WindowsHandles.stderr ===================================== @@ -0,0 +1,3 @@ +And every single door +That I've walked through +Brings me back, back here again ===================================== libraries/base/tests/IO/osHandles002WindowsHandles.stdin ===================================== @@ -0,0 +1 @@ +We've got to get in to get out ===================================== libraries/base/tests/IO/osHandles002WindowsHandles.stdout ===================================== @@ -0,0 +1 @@ +We've got to get in to get out ===================================== libraries/base/tests/perf/Makefile ===================================== @@ -12,4 +12,4 @@ T17752: # All occurrences of elem should be optimized away. # For strings these should result in loops after inlining foldCString. # For lists it should result in a case expression. - echo $$(cat T17752.dump-simpl | grep "elem" -A4 ) + echo $$(grep -A4 "elem" T17752.dump-simpl) ===================================== libraries/ghc-internal/ghc-internal.cabal.in ===================================== @@ -328,6 +328,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,323 @@ +{-# 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 + preparation 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 user-defined preparation is performed. +-} + +{-| + 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#This subsection is just a dummy, whose purpose is to serve + as the target of the hyperlinks above. The real documentation of the caveats + is in the /Caveats/ subsection in the @base@ module @System.IO.OS@, which + re-exports the above operations. +-} ===================================== testsuite/tests/driver/T16318/Makefile ===================================== @@ -7,5 +7,5 @@ test_pe = test-package-environment T16318: "$(GHC_PKG)" field base id --simple-output > $(test_pe) "$(TEST_HC)" $(TEST_HC_OPTS) -v1 -ignore-dot-ghci -package-env $(test_pe) -e "putStrLn \"Hello\"" > out 2>&1 - C=`cat out | grep "Loaded package environment" -c` ; \ + C=`grep -c "Loaded package environment" out` ; \ if [ $$C != "1" ]; then false; fi ===================================== testsuite/tests/driver/T18125/Makefile ===================================== @@ -9,5 +9,5 @@ T18125: "$(GHC_PKG)" field base id --simple-output > $(test_pe) "$(GHC_PKG)" field $(test_lib) id --simple-outpu >> $(test_pe) "$(TEST_HC)" $(TEST_HC_OPTS) -Wunused-packages -package-env $(test_pe) T18125.hs > out 2>&1 - C=`cat out | grep "$(test_lib)" -c` ; \ + C=`grep -c "$(test_lib)" out` ; \ if [ $$C != "1" ]; then false; fi ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -10048,6 +10048,17 @@ module System.IO.Error where userError :: GHC.Internal.Base.String -> IOError userErrorType :: IOErrorType +module System.IO.OS where + -- Safety: Safe + withFileDescriptorReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + module System.IO.Unsafe where -- Safety: Unsafe unsafeDupablePerformIO :: forall a. GHC.Internal.Types.IO a -> a ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -10086,6 +10086,17 @@ module System.IO.Error where userError :: GHC.Internal.Base.String -> IOError userErrorType :: IOErrorType +module System.IO.OS where + -- Safety: Safe + withFileDescriptorReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + module System.IO.Unsafe where -- Safety: Unsafe unsafeDupablePerformIO :: forall a. GHC.Internal.Types.IO a -> a ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -10328,6 +10328,17 @@ module System.IO.Error where userError :: GHC.Internal.Base.String -> IOError userErrorType :: IOErrorType +module System.IO.OS where + -- Safety: Safe + withFileDescriptorReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + module System.IO.Unsafe where -- Safety: Unsafe unsafeDupablePerformIO :: forall a. GHC.Internal.Types.IO a -> a ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -10048,6 +10048,17 @@ module System.IO.Error where userError :: GHC.Internal.Base.String -> IOError userErrorType :: IOErrorType +module System.IO.OS where + -- Safety: Safe + withFileDescriptorReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withFileDescriptorWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Foreign.C.Types.CInt -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleReadingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiased :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + withWindowsHandleWritingBiasedRaw :: forall r. GHC.Internal.IO.Handle.Types.Handle -> (GHC.Internal.Ptr.Ptr () -> GHC.Internal.Types.IO r) -> GHC.Internal.Types.IO r + module System.IO.Unsafe where -- Safety: Unsafe unsafeDupablePerformIO :: forall a. GHC.Internal.Types.IO a -> a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b05ae7f3bab12fbb43cebdf18148e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b05ae7f3bab12fbb43cebdf18148e… You're receiving this email because of your account on gitlab.haskell.org.

1 0