[Git][ghc/ghc][wip/dcoutts/io-manager-feature-bitset] In GHC.Internal.Conc.IO more uniform dispatch to alternatives

29 Oct 2026


      Duncan Coutts pushed to branch wip/dcoutts/io-manager-feature-bitset at Glasgow Haskell Compiler / GHC


Commits:
4e7cb00e by Duncan Coutts at 2026-10-29T11:39:45+00:00
In GHC.Internal.Conc.IO more uniform dispatch to alternatives

Reduce and consolotate the amount of CPP used to select between
different implementations of the I/O manager actions.

In particular, bring the Windows and non-Windows alternatives closer:
1. by importing the modules with the same qualified as name
2. in a couple cases by providing no-op versions of APIs so that we have
   a more uniform API between the two

Also introduce a HAVE_IOMGR_IN_LIB define, and use that to have a static
guard over the (dynamic guard) to call in-lib I/O manager functions. The
pattern ends up (mostly uniformly) as:

 blahIOManager
 #if defined(HAVE_IOMGR_IN_LIB)
   | iomgrInLib = IOMgr.blahIOManager
 #endif
   | otherwise  = ... -- the in-RTS version
 #endif

Note:
* HAVE_IOMGR_IN_LIB is a static choice
* iomgrInLib is a dynamic choice

Where previously there was a _lot_ more ad-hoc CPP. In particular this
now covers JS and wasm more consistently, by saying they do _not_
define HAVE_IOMGR_IN_LIB, and thus only ever call the in-RTS variants.

And while we're at it, make threadWaitRead, threadWaitWrite fail more
politely on Windows, by throwing an exception rather than terminating
the RTS!

On wasm, this decreases the amount of the base library object code that
gets linked into a static hello world program, because the threaded I/O
manager is dead code that can be avoided by the linker.

-------------------------
Metric Decrease:
    size_hello_artifact
    size_hello_artifact_gzip
    size_hello_unicode
    size_hello_unicode_gzip
-------------------------

- - - - -


3 changed files:

- libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs


Changes:

=====================================
libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
=====================================
@@ -67,36 +67,47 @@ import qualified GHC.Internal.Foreign.C.Error as C
 import GHC.Internal.Foreign.C.Types (CInt)
 import GHC.Internal.Maybe (Maybe(Nothing))
 import GHC.Internal.STM as STM
-import GHC.Internal.Prim (Int#, State#, RealWorld,
-                          delay#, waitRead#, waitWrite#, raiseIO#)
+import GHC.Internal.Prim (Int#, State#, RealWorld, delay#, raiseIO#)
 import GHC.Internal.Real ( fromIntegral )
 import GHC.Internal.System.Posix.Types
 
-#if !defined(javascript_HOST_ARCH)
-import GHC.Internal.IO.SubSystem
-#endif
-
 #if defined(mingw32_HOST_OS)
-import qualified GHC.Internal.Conc.Windows as Windows
 import GHC.Internal.Conc.Windows (asyncRead, asyncWrite, asyncDoProc, asyncReadBA,
                          asyncWriteBA, ConsoleEvent(..), win32ConsoleHandler,
                          toWin32ConsoleEvent)
-#elif !defined(javascript_HOST_ARCH)
-import qualified GHC.Internal.Event.Thread as Event
+#else
+import GHC.Internal.Prim (waitRead#, waitWrite#)
+#endif
+
+-- A switch to control support for calling in-library I/O managers.
+-- Plausible future directions: hoist this to .cabal file feature flag.
+#if defined(javascript_HOST_ARCH)
+-- Turned off for JS (which only has a single in-RTS I/O manager).
+#elif defined(wasm32_HOST_ARCH)
+-- Turned off for wasm (which only has in-RTS I/O managers).
+#else
+-- all other platforms
+#define HAVE_IOMGR_IN_LIB
+#endif
+
+#if defined(HAVE_IOMGR_IN_LIB)
+import GHC.Internal.IO.SubSystem
+#if defined(mingw32_HOST_OS)
+import qualified GHC.Internal.Conc.Windows as IOMgr
+#else
+import qualified GHC.Internal.Event.Thread as IOMgr
+#endif
 #endif
 
 #if defined(wasm32_HOST_ARCH)
-import qualified GHC.Internal.Wasm.Prim.Conc as Wasm
-import qualified GHC.Internal.Wasm.Prim.Flag as Wasm
+import qualified GHC.Internal.Wasm.Prim.Conc as Wasm (threadDelay)
+import qualified GHC.Internal.Wasm.Prim.Flag as Wasm (isJSFFIUsed)
 #endif
 
 ensureIOManagerIsRunning :: IO ()
-#if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
-ensureIOManagerIsRunning
-  | iomgrInLib = Event.ensureIOManagerIsRunning
-#elif !defined(javascript_HOST_ARCH)
 ensureIOManagerIsRunning
-  | iomgrInLib = Windows.ensureIOManagerIsRunning
+#if defined(HAVE_IOMGR_IN_LIB)
+  | iomgrInLib = IOMgr.ensureIOManagerIsRunning
 #endif
   | otherwise  = return ()
 
@@ -107,15 +118,15 @@ ensureIOManagerIsRunning
 -- @since base-4.15
 interruptIOManager :: IO ()
 interruptIOManager
-#if defined(mingw32_HOST_OS)
-  | iomgrInLib = Windows.interruptIOManager
+#if defined(HAVE_IOMGR_IN_LIB)
+  | iomgrInLib = IOMgr.interruptIOManager
 #endif
   | otherwise  = return ()
 
 ioManagerCapabilitiesChanged :: IO ()
 ioManagerCapabilitiesChanged
-#if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
-  | iomgrInLib = Event.ioManagerCapabilitiesChanged
+#if defined(HAVE_IOMGR_IN_LIB)
+  | iomgrInLib = IOMgr.ioManagerCapabilitiesChanged
 #endif
   | otherwise  = return ()
 
@@ -126,14 +137,20 @@ ioManagerCapabilitiesChanged
 -- while this thread was blocked.  To safely close a file descriptor
 -- that has been used with 'threadWaitRead', use 'closeFdWith'.
 threadWaitRead :: Fd -> IO ()
+#if !defined(mingw32_HOST_OS)
 threadWaitRead fd
-#if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
-  | iomgrInLib = Event.threadWaitRead fd
+#if defined(HAVE_IOMGR_IN_LIB)
+  | iomgrInLib = IOMgr.threadWaitRead fd
 #endif
   | otherwise  = IO $ \s ->
         case fromIntegral fd of { I# fd# ->
         case waitRead# fd# s of { s' -> (# s', () #)
         }}
+#else
+threadWaitRead _fd
+  = errorWithoutStackTrace "threadWaitRead: not available on Windows"
+#endif
+
 
 -- | Block the current thread until data can be written to the
 -- given file descriptor (GHC only).
@@ -142,14 +159,19 @@ threadWaitRead fd
 -- while this thread was blocked.  To safely close a file descriptor
 -- that has been used with 'threadWaitWrite', use 'closeFdWith'.
 threadWaitWrite :: Fd -> IO ()
+#if !defined(mingw32_HOST_OS)
 threadWaitWrite fd
-#if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
-  | iomgrInLib = Event.threadWaitWrite fd
+#if defined(HAVE_IOMGR_IN_LIB)
+  | iomgrInLib = IOMgr.threadWaitWrite fd
 #endif
   | otherwise  = IO $ \s ->
         case fromIntegral fd of { I# fd# ->
         case waitWrite# fd# s of { s' -> (# s', () #)
         }}
+#else
+threadWaitWrite _fd
+  = errorWithoutStackTrace "threadWaitWrite: not available on Windows"
+#endif
 
 -- | Returns an STM action that can be used to wait for data
 -- to read from a file descriptor. The second returned value
@@ -157,8 +179,8 @@ threadWaitWrite fd
 -- in the file descriptor.
 threadWaitReadSTM :: Fd -> IO (STM.STM (), IO ())
 threadWaitReadSTM fd
-#if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
-  | iomgrInLib = Event.threadWaitReadSTM fd
+#if defined(HAVE_IOMGR_IN_LIB) && !defined(mingw32_HOST_OS)
+  | iomgrInLib = IOMgr.threadWaitReadSTM fd
 #endif
   | otherwise  = do
       m <- STM.newTVarIO False
@@ -176,8 +198,8 @@ threadWaitReadSTM fd
 -- in the file descriptor.
 threadWaitWriteSTM :: Fd -> IO (STM.STM (), IO ())
 threadWaitWriteSTM fd
-#if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
-  | iomgrInLib = Event.threadWaitWriteSTM fd
+#if defined(HAVE_IOMGR_IN_LIB) && !defined(mingw32_HOST_OS)
+  | iomgrInLib = IOMgr.threadWaitWriteSTM fd
 #endif
   | otherwise  = do
       m <- STM.newTVarIO False
@@ -209,8 +231,8 @@ closeFdWith :: (Fd -> IO ()) -- ^ Low-level action that performs the real close.
             -> Fd            -- ^ File descriptor to close.
             -> IO ()
 closeFdWith close fd
-#if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
-  | iomgrInLib = Event.closeFdWith close fd
+#if defined(HAVE_IOMGR_IN_LIB) && !defined(mingw32_HOST_OS)
+  | iomgrInLib = IOMgr.closeFdWith close fd
 #endif
   | otherwise  = close fd
 
@@ -226,12 +248,10 @@ closeFdWith close fd
 -- Consider using @Control.Concurrent.Thread.Delay.delay@ from @unbounded-delays@ package.
 threadDelay :: Int -> IO ()
 threadDelay time
-#if defined(mingw32_HOST_OS)
-  | iomgrInLib        = Windows.threadDelay time
+#if defined(HAVE_IOMGR_IN_LIB)
+  | iomgrInLib        = IOMgr.threadDelay time
 #elif defined(wasm32_HOST_ARCH)
   | Wasm.isJSFFIUsed  = Wasm.threadDelay time
-#elif !defined(javascript_HOST_ARCH)
-  | iomgrInLib        = Event.threadDelay time
 #endif
   | otherwise         = IO $ \s ->
         case time of { I# time# ->
@@ -247,12 +267,10 @@ threadDelay time
 --
 registerDelay :: Int -> IO (TVar Bool)
 registerDelay _usecs
-#if defined(mingw32_HOST_OS)
-  | iomgrInLib        = Windows.registerDelay _usecs
-#elif !defined(javascript_HOST_ARCH)
-  | iomgrInLib        = Event.registerDelay _usecs
+#if defined(HAVE_IOMGR_IN_LIB)
+  | iomgrInLib = IOMgr.registerDelay _usecs
 #endif
-  | otherwise         = errorWithoutStackTrace "registerDelay: requires -threaded"
+  | otherwise  = errorWithoutStackTrace "registerDelay: requires -threaded"
 
 
 -- ---------------------------------------------------------------------------


=====================================
libraries/ghc-internal/src/GHC/Internal/Conc/Windows.hs
=====================================
@@ -24,6 +24,7 @@ module GHC.Internal.Conc.Windows
 #else
        ( ensureIOManagerIsRunning
        , interruptIOManager
+       , ioManagerCapabilitiesChanged
 
        -- * Waiting
        , threadDelay
@@ -41,7 +42,7 @@ module GHC.Internal.Conc.Windows
        , module GHC.Internal.Event.Windows.ConsoleEvent
        ) where
 
-import GHC.Internal.Base (($))
+import GHC.Internal.Base (($), return)
 import qualified GHC.Internal.Conc.POSIX as POSIX
 import qualified GHC.Internal.Event.Windows.Thread as WINIO
 import GHC.Internal.Event.Windows.ConsoleEvent
@@ -122,4 +123,8 @@ ensureIOManagerIsRunning =  POSIX.ensureIOManagerIsRunning
 interruptIOManager :: IO ()
 interruptIOManager = POSIX.interruptIOManager <!> WINIO.interruptIOManager
 
+-- No-op. Here to provide a uniform API to call in GHC.Internal.Conc.IO
+ioManagerCapabilitiesChanged :: IO ()
+ioManagerCapabilitiesChanged = return ()
+
 #endif


=====================================
libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
=====================================
@@ -15,6 +15,7 @@ import GHC.Internal.Types ()
     ( getSystemEventManager
     , getSystemTimerManager
     , ensureIOManagerIsRunning
+    , interruptIOManager
     , ioManagerCapabilitiesChanged
     , threadWaitRead
     , threadWaitWrite
@@ -459,4 +460,8 @@ foreign import ccall unsafe "setTimerManagerControlFd"
    c_setTimerManagerControlFd :: CInt -> IO ()
 #endif
 
+-- No-op. Here to provide a uniform API to call in GHC.Internal.Conc.IO
+interruptIOManager :: IO ()
+interruptIOManager = return ()
+
 #endif



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4e7cb00e60c20eb041c8403dcf577bdf...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4e7cb00e60c20eb041c8403dcf577bdf...
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

    

Duncan Coutts (＠dcoutts)

tags

participants (1)