[Git][ghc/ghc][wip/semaphore-v2] Update to semaphore-compat 2.0.0 using v2 of the protocol
by Zubin (＠wz1000) 19 May '26
by Zubin (＠wz1000) 19 May '26
19 May '26
Zubin pushed to branch wip/semaphore-v2 at Glasgow Haskell Compiler / GHC
Commits:
d6b0d41e by Zubin Duggal at 2026-05-19T14:30:32+05:30
Update to semaphore-compat 2.0.0 using v2 of the protocol
On Linux and other POSIX platforms, GHC's -jsem jobserver client now
speaks v2 of the semaphore-compat protocol, which uses Unix domain
sockets in place of POSIX named semaphores. This avoids the libc-ABI
issues that affected the old implementation. Windows is unaffected
and continues to use the v1 protocol (Win32 named semaphores); its
reported protocol version remains v1.
When GHC receives a -jsem name whose protocol version it does not
support, it emits a -Wsemaphore-version-mismatch warning and falls
back to -j<N> rather than crashing. ghc --info exposes the supported
version in a new "Semaphore version" entry so cabal-install can detect
a mismatch before invoking GHC.
Users on a cabal-install that predates the v2 update will continue to
build successfully on Linux/POSIX, but will lose the cross-process
-jsem coordination and fall back to -j<N> per GHC invocation. Users
must upgrade to a cabal-install that supports protocol v2 to recover
full parallelism.
Also fix a leak in cleanupSem (#27253): cleanupSem used to snapshot
heldTokens and release them before killing the loop, while the loop's
in-flight acquire/release children could still be mutating it.
Cleanup now runs inside the loop's own exit handler, after draining
the active child via a new activeChild TVar, so the snapshot has no
concurrent mutator.
See also:
- GHC proposal amendment: https://github.com/ghc-proposals/ghc-proposals/pull/673
- cabal-install patch: https://github.com/haskell/cabal/pull/11628
- semaphore-compat MR: https://gitlab.haskell.org/ghc/semaphore-compat/-/merge_requests/8
Bump semaphore-compat submodule to 2.0.0
Fixes #25087 and #27253
- - - - -
19 changed files:
- + changelog.d/jobserver-leak-fix
- + changelog.d/semaphore-v2
- compiler/GHC/Driver/Errors/Ppr.hs
- compiler/GHC/Driver/Errors/Types.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/MakeAction.hs
- compiler/GHC/Driver/MakeSem.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Types/Error/Codes.hs
- docs/users_guide/using-warnings.rst
- docs/users_guide/using.rst
- hadrian/cabal.project
- hadrian/hadrian.cabal
- hadrian/src/Flavour.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Settings/Packages.hs
- hadrian/stack.yaml
- libraries/semaphore-compat
- testsuite/tests/diagnostic-codes/codes.stdout
Changes:
=====================================
changelog.d/jobserver-leak-fix
=====================================
@@ -0,0 +1,8 @@
+section: compiler
+issues: #27253
+mrs: !15729
+synopsis:
+ Fix a token leak in the ``-jsem`` jobserver shutdown path
+description:
+ A build interrupted by Ctrl-C while a ``-jsem`` token transfer was in
+ flight could leak that token.
=====================================
changelog.d/semaphore-v2
=====================================
@@ -0,0 +1,30 @@
+section: compiler
+issues: #25087
+mrs: !15729
+synopsis:
+ Update to semaphore-compat 2.0.0 (``-jsem`` protocol v2)
+description:
+ On Linux and other POSIX platforms, GHC's ``-jsem`` jobserver client
+ now speaks v2 of the semaphore-compat protocol, which uses Unix
+ domain sockets in place of POSIX named semaphores. This avoids the
+ libc-ABI issues that affected the old implementation. Windows is
+ unaffected and continues to use the v1 protocol (Win32 named
+ semaphores); its reported protocol version remains v1.
+
+ When GHC receives a ``-jsem`` name whose protocol version it does not
+ support, it now emits a ``-Wsemaphore-version-mismatch`` warning and
+ falls back to ``-j1`` rather than crashing. ``ghc --info`` exposes the
+ supported version in a new ``"Semaphore version"`` entry so
+ cabal-install can detect a mismatch before invoking GHC.
+
+ Users on a ``cabal-install`` that predates the v2 update will continue
+ to build successfully on Linux/POSIX, but will lose the cross-process
+ ``-jsem`` coordination and fall back to ``-j1`` per GHC invocation.
+ To recover full parallelism, upgrade to a ``cabal-install`` that
+ supports protocol v2.
+
+ See also:
+
+ - the `GHC proposal amendment <https://github.com/ghc-proposals/ghc-proposals/pull/673>`_
+ - the `cabal-install patch <https://github.com/haskell/cabal/pull/11628>`_
+ - the `semaphore-compat library MR <https://gitlab.haskell.org/ghc/semaphore-compat/-/merge_requests/8>`_
=====================================
compiler/GHC/Driver/Errors/Ppr.hs
=====================================
@@ -24,6 +24,8 @@ import GHC.Types.Hint
import GHC.Types.SrcLoc
import Data.Version
+import System.Semaphore
+ ( SemaphoreError(..), getSemaphoreProtocolVersion )
import Language.Haskell.Syntax.Decls (RuleDecl(..))
import GHC.Tc.Errors.Types (TcRnMessage)
import GHC.HsToCore.Errors.Types (DsMessage)
@@ -90,6 +92,20 @@ instance Diagnostic GhcMessage where
instance HasDefaultDiagnosticOpts DriverMessageOpts where
defaultOpts = DriverMessageOpts (defaultDiagnosticOpts @PsMessage) (defaultDiagnosticOpts @IfaceMessage)
+pprSemaphoreError :: SemaphoreError -> SDoc
+pprSemaphoreError = \case
+ SemaphoreAlreadyExists nm ->
+ text "a semaphore named" <+> quotes (text nm) <+> text "already exists"
+ SemaphoreDoesNotExist nm ->
+ text "no semaphore named" <+> quotes (text nm)
+ SemaphoreIncompatibleVersion got want ->
+ text "protocol version mismatch (got v"
+ <> int (getSemaphoreProtocolVersion got)
+ <> text ", supported v"
+ <> int (getSemaphoreProtocolVersion want) <> text ")"
+ SemaphoreOtherError ioe ->
+ text (show ioe)
+
instance Diagnostic DriverMessage where
type DiagnosticOpts DriverMessage = DriverMessageOpts
diagnosticMessage opts = \case
@@ -282,6 +298,10 @@ instance Diagnostic DriverMessage where
-> mkSimpleDecorated $
vcat [ text "The following modules are missing a linkable which is needed for creating a library:"
, nest 2 $ hcat (map ppr mods) ]
+ DriverSemaphoreOpenFailure err
+ -> mkSimpleDecorated $
+ text "Failed to open -jsem semaphore:" <+> pprSemaphoreError err <>
+ text "; ignoring -jsem and compiling sequentially."
diagnosticReason = \case
DriverUnknownMessage m
@@ -355,6 +375,8 @@ instance Diagnostic DriverMessage where
-> WarningWithoutFlag
DriverMissingLinkableForModule {}
-> ErrorWithoutFlag
+ DriverSemaphoreOpenFailure {}
+ -> WarningWithFlag Opt_WarnSemaphoreOpenFailure
diagnosticHints = \case
DriverUnknownMessage m
@@ -430,5 +452,14 @@ instance Diagnostic DriverMessage where
-> noHints
DriverMissingLinkableForModule {}
-> noHints
+ DriverSemaphoreOpenFailure (SemaphoreIncompatibleVersion received supported)
+ | received < supported
+ -> [UnknownHint (text "The parent process (e.g. cabal-install) uses an older semaphore protocol."
+ $$ text "Upgrading cabal-install may resolve this." :: SDoc)]
+ | otherwise
+ -> [UnknownHint (text "The parent process (e.g. cabal-install) uses a newer semaphore protocol."
+ $$ text "Upgrading GHC may resolve this." :: SDoc)]
+ DriverSemaphoreOpenFailure {}
+ -> noHints
diagnosticCode = constructorCode @GHC
=====================================
compiler/GHC/Driver/Errors/Types.hs
=====================================
@@ -37,6 +37,7 @@ import qualified GHC.LanguageExtensions as LangExt
import GHC.Generics ( Generic )
+import System.Semaphore ( SemaphoreError )
import GHC.Tc.Errors.Types
import GHC.Iface.Errors.Types
@@ -419,6 +420,13 @@ data DriverMessage where
DriverMissingLinkableForModule :: ![Module] -> DriverMessage
+ {-| DriverSemaphoreOpenFailure is a warning that occurs when GHC fails to
+ open the semaphore specified by @-jsem@, e.g. the socket does not
+ exist, the protocol version is incompatible, or a system error
+ occurred. GHC ignores @-jsem@ and compiles sequentially.
+ -}
+ DriverSemaphoreOpenFailure :: !SemaphoreError -> DriverMessage
+
deriving instance Generic DriverMessage
data DriverMessageOpts =
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -1115,6 +1115,7 @@ data WarningFlag =
| Opt_WarnUnusableUnpackPragmas -- ^ @since 9.14
| Opt_WarnPatternNamespaceSpecifier -- ^ @since 9.14
| Opt_WarnUnrecognisedModifiers -- ^ @since 10.0
+ | Opt_WarnSemaphoreOpenFailure -- Since 10.0.1
deriving (Eq, Ord, Show, Enum, Bounded)
-- | Return the names of a WarningFlag
@@ -1237,6 +1238,7 @@ warnFlagNames wflag = case wflag of
Opt_WarnUnusableUnpackPragmas -> "unusable-unpack-pragmas" :| []
Opt_WarnPatternNamespaceSpecifier -> "pattern-namespace-specifier" :| []
Opt_WarnUnrecognisedModifiers -> "unrecognised-modifiers" :| []
+ Opt_WarnSemaphoreOpenFailure -> "semaphore-open-failure" :| []
-- -----------------------------------------------------------------------------
-- Standard sets of warning options
@@ -1383,7 +1385,8 @@ standardWarnings -- see Note [Documenting warning flags]
Opt_WarnDeprecatedPragmas,
Opt_WarnRuleLhsEqualities,
Opt_WarnUnusableUnpackPragmas,
- Opt_WarnUnrecognisedModifiers
+ Opt_WarnUnrecognisedModifiers,
+ Opt_WarnSemaphoreOpenFailure
]
-- | Things you get with @-W@.
=====================================
compiler/GHC/Driver/MakeAction.hs
=====================================
@@ -28,6 +28,14 @@ import GHC.Driver.Errors.Types
import GHC.Driver.Messager
import GHC.Driver.MakeSem
+import System.Semaphore
+ ( SemaphoreError, SemaphoreIdentifier )
+
+import GHC.Driver.Config.Diagnostic ( initDiagOpts, initPrintConfig )
+import GHC.Driver.Errors ( printOrThrowDiagnostics )
+import GHC.Types.Error ( singleMessage )
+import GHC.Types.SrcLoc ( noSrcSpan )
+import GHC.Utils.Error ( mkPlainMsgEnvelope )
import GHC.Utils.Logger
import GHC.Utils.TmpFs
@@ -49,7 +57,7 @@ mkWorkerLimit :: DynFlags -> IO WorkerLimit
mkWorkerLimit dflags =
case parMakeCount dflags of
Nothing -> pure $ num_procs 1
- Just (ParMakeSemaphore h) -> pure (JSemLimit (SemaphoreName h))
+ Just (ParMakeSemaphore h) -> pure (JSemLimit h)
Just ParMakeNumProcessors -> num_procs <$> getNumProcessors
Just (ParMakeThisMany n) -> pure $ num_procs n
where
@@ -65,8 +73,8 @@ isWorkerLimitSequential (JSemLimit {}) = False
data WorkerLimit
= NumProcessorsLimit Int
| JSemLimit
- SemaphoreName
- -- ^ Semaphore name to use
+ SemaphoreIdentifier
+ -- ^ Semaphore identifier from @-jsem@
deriving Eq
-- | Environment used when compiling a module
@@ -122,17 +130,24 @@ runNjobsAbstractSem n_jobs action = do
resetNumCapabilities = set_num_caps n_capabilities
MC.bracket_ updNumCapabilities resetNumCapabilities $ action asem
-runWorkerLimit :: WorkerLimit -> (AbstractSem -> IO a) -> IO a
+runWorkerLimit :: Logger -> DynFlags -> WorkerLimit -> (AbstractSem -> IO a) -> IO a
#if defined(wasm32_HOST_ARCH)
-runWorkerLimit _ action = do
+runWorkerLimit _logger _dflags _ action = do
lock <- newMVar ()
action $ AbstractSem (takeMVar lock) (putMVar lock ())
#else
-runWorkerLimit worker_limit action = case worker_limit of
+runWorkerLimit logger dflags worker_limit action = case worker_limit of
NumProcessorsLimit n_jobs ->
runNjobsAbstractSem n_jobs action
- JSemLimit sem ->
- runJSemAbstractSem sem action
+ JSemLimit sem_ident -> do
+ result <- MC.try @SemaphoreError $ runJSemAbstractSem sem_ident action
+ case result of
+ Right a -> return a
+ Left err -> do
+ let diag = DriverSemaphoreOpenFailure err
+ msg = singleMessage $ mkPlainMsgEnvelope (initDiagOpts dflags) noSrcSpan diag
+ printOrThrowDiagnostics logger (initPrintConfig dflags) (initDiagOpts dflags) (GhcDriverMessage <$> msg)
+ runNjobsAbstractSem 1 action
#endif
-- | Build and run a pipeline
@@ -159,7 +174,7 @@ runParPipelines worker_limit plugin_hsc_env diag_wrapper mHscMessager all_pipeli
thread_safe_logger <- liftIO $ makeThreadSafe (hsc_logger plugin_hsc_env)
let thread_safe_hsc_env = plugin_hsc_env { hsc_logger = thread_safe_logger }
- runWorkerLimit worker_limit $ \abstract_sem -> do
+ runWorkerLimit (hsc_logger plugin_hsc_env) (hsc_dflags plugin_hsc_env) worker_limit $ \abstract_sem -> do
let env = MakeEnv { hsc_env = thread_safe_hsc_env
, withLogger = withParLog log_queue_queue_var
, compile_sem = abstract_sem
=====================================
compiler/GHC/Driver/MakeSem.hs
=====================================
@@ -9,9 +9,6 @@ module GHC.Driver.MakeSem
-- by a system semaphore (Posix/Windows)
runJSemAbstractSem
- -- * System semaphores
- , Semaphore, SemaphoreName(..)
-
-- * Abstract semaphores
, AbstractSem(..)
, withAbstractSem
@@ -46,11 +43,14 @@ import Debug.Trace
-- available from the semaphore.
data Jobserver
= Jobserver
- { jSemaphore :: !Semaphore
+ { jSemaphore :: !ClientSemaphore
-- ^ The semaphore which controls available resources
, jobs :: !(TVar JobResources)
-- ^ The currently pending jobs, and the resources
-- obtained from the semaphore
+ , activeChild :: !(TVar (Maybe (ThreadId, TMVar (Maybe MC.SomeException))))
+ -- ^ Handle on the current acquire thread (if any). The loop's exit
+ -- handler reads this to drain a still-running child on shutdown.
}
data JobserverOptions
@@ -81,6 +81,9 @@ data JobResources
, jobsWaiting :: !(OrdList (TMVar ()))
-- ^ Pending jobs waiting on a token, the job will be blocked on the TMVar so putting into
-- the TMVar will allow the job to continue.
+ , heldTokens :: [SemaphoreToken]
+ -- ^ Actual semaphore tokens (for release/cleanup).
+ -- Length should equal tokensOwned - 1 (the implicit token has no SemaphoreToken).
}
instance Outputable JobResources where
@@ -93,9 +96,9 @@ instance Outputable JobResources where
] )
-- | Add one new token.
-addToken :: JobResources -> JobResources
-addToken jobs@( Jobs { tokensOwned = owned, tokensFree = free })
- = jobs { tokensOwned = owned + 1, tokensFree = free + 1 }
+addToken :: SemaphoreToken -> JobResources -> JobResources
+addToken tok jobs@( Jobs { tokensOwned = owned, tokensFree = free, heldTokens = toks })
+ = jobs { tokensOwned = owned + 1, tokensFree = free + 1, heldTokens = tok : toks }
-- | Free one token.
addFreeToken :: JobResources -> JobResources
@@ -111,12 +114,14 @@ removeFreeToken jobs@( Jobs { tokensFree = free })
(text "removeFreeToken:" <+> ppr free)
$ jobs { tokensFree = free - 1 }
--- | Return one owned token.
-removeOwnedToken :: JobResources -> JobResources
-removeOwnedToken jobs@( Jobs { tokensOwned = owned })
+-- | Return one owned token, extracting the 'SemaphoreToken' for release.
+removeOwnedToken :: JobResources -> (SemaphoreToken, JobResources)
+removeOwnedToken jobs@( Jobs { tokensOwned = owned, heldTokens = toks })
= assertPpr (owned > 1)
(text "removeOwnedToken:" <+> ppr owned)
- $ jobs { tokensOwned = owned - 1 }
+ $ case toks of
+ (t:rest) -> (t, jobs { tokensOwned = owned - 1, heldTokens = rest })
+ [] -> panic "removeOwnedToken: no held tokens"
-- | Add one new job to the end of the list of pending jobs.
addJob :: TMVar () -> JobResources -> JobResources
@@ -143,7 +148,7 @@ data JobserverAction
= Idle
-- | A thread is waiting for a token on the semaphore.
| Acquiring
- { activeWaitId :: WaitId
+ { activeThreadId :: ThreadId
, threadFinished :: TMVar (Maybe MC.SomeException) }
-- | Retrieve the 'TMVar' that signals if the current thread has finished,
@@ -189,17 +194,30 @@ releaseJob jobs_tvar = do
return ((), addFreeToken jobs)
--- | Release all tokens owned from the semaphore (to clean up
--- the jobserver at the end).
-cleanupJobserver :: Jobserver -> IO ()
-cleanupJobserver (Jobserver { jSemaphore = sem
- , jobs = jobs_tvar })
- = do
- Jobs { tokensOwned = owned } <- readTVarIO jobs_tvar
- let toks_to_release = owned - 1
- -- Subtract off the implicit token: whoever spawned the ghc process
- -- in the first place is responsible for that token.
- releaseSemaphore sem toks_to_release
+-- | Kill the current acquire thread, if any, and wait for it to exit.
+--
+-- Called from the jobserver loop's exit handler, which runs masked.
+-- Relies on the invariant from 'acquireThread' that a forked child
+-- always fills its 'threadFinished' TMVar before it dies; this is what
+-- lets the 'takeTMVar' below terminate after the 'killThread'.
+drainActiveChild :: Jobserver -> IO ()
+drainActiveChild (Jobserver { activeChild = active_tvar }) = do
+ mb <- readTVarIO active_tvar
+ for_ mb $ \(tid, tmv) -> do
+ killThread tid
+ void $ atomically (takeTMVar tmv)
+ atomically $ writeTVar active_tvar Nothing
+
+-- | Release every token currently in 'heldTokens'.
+--
+-- Called from the jobserver loop's exit handler, which runs masked,
+-- after 'drainActiveChild': no other thread is mutating 'JobResources'
+-- at this point.
+releaseAllHeld :: Jobserver -> IO ()
+releaseAllHeld (Jobserver { jobs = jobs_tvar }) = do
+ Jobs { heldTokens = toks } <- readTVarIO jobs_tvar
+ forM_ toks $ \t ->
+ void $ MC.try @MC.SomeException (releaseSemaphoreToken t)
-- | Dispatch the available tokens acquired from the semaphore
-- to the pending jobs in the job server.
@@ -252,7 +270,7 @@ tracedAtomically origin act = do
return a
renderJobResources :: String -> JobResources -> String
-renderJobResources origin (Jobs own free pending) = showSDocUnsafe $ renderJSON $
+renderJobResources origin (Jobs own free pending _heldToks) = showSDocUnsafe $ renderJSON $
JSObject [ ("name", JSString origin)
, ("owned", JSInt own)
, ("free", JSInt free)
@@ -262,61 +280,68 @@ renderJobResources origin (Jobs own free pending) = showSDocUnsafe $ renderJSON
-- | Spawn a new thread that waits on the semaphore in order to acquire
-- an additional token.
+--
+-- The child is forked masked so the only async-exception delivery point
+-- is the interruptible 'waitOnSemaphore'; the STM commit afterwards then
+-- always runs to completion, so 'threadFinished' is always filled.
+--
+-- The (tid, threadFinished) pair is also published to 'activeChild' so
+-- shutdown can drain the child even after the in-loop 'JobserverState'
+-- is gone.
acquireThread :: Jobserver -> IO JobserverAction
-acquireThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do
+acquireThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar, activeChild = active_tvar }) = do
threadFinished_tmvar <- newEmptyTMVarIO
- let
- wait_result_action :: Either MC.SomeException Bool -> IO ()
- wait_result_action wait_res =
+ tid <- MC.mask_ $ do
+ tid <- forkIO $ do
+ wait_res <- MC.try @_ @MC.SomeException $ waitOnSemaphore sem
tracedAtomically_ "acquire_thread" do
(r, jb) <- case wait_res of
Left (e :: MC.SomeException) -> do
return $ (Just e, Nothing)
- Right success -> do
- if success
- then do
- modifyJobResources jobs_tvar \ jobs ->
- return (Nothing, addToken jobs)
- else
- return (Nothing, Nothing)
+ Right tok -> do
+ modifyJobResources jobs_tvar \ jobs ->
+ return (Nothing, addToken tok jobs)
putTMVar threadFinished_tmvar r
return jb
- wait_id <- forkWaitOnSemaphoreInterruptible sem wait_result_action
- labelThread (waitingThreadId wait_id) "acquire_thread"
- return $ Acquiring { activeWaitId = wait_id
+ atomically $ writeTVar active_tvar (Just (tid, threadFinished_tmvar))
+ return tid
+ labelThread tid "acquire_thread"
+ return $ Acquiring { activeThreadId = tid
, threadFinished = threadFinished_tmvar }
-- | Spawn a thread to release ownership of one resource from the semaphore,
-- provided we have spare resources and no pending jobs.
releaseThread :: Jobserver -> IO JobserverAction
-releaseThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do
+releaseThread (Jobserver { jobs = jobs_tvar }) = do
threadFinished_tmvar <- newEmptyTMVarIO
MC.mask_ do
-- Pre-release the resource so that another thread doesn't take control of it
-- just as we release the lock on the semaphore.
- still_ok_to_release
+ mb_tok
<- tracedAtomically "pre_release" $
modifyJobResources jobs_tvar \ jobs ->
if guardRelease jobs
- -- TODO: should this also debounce?
- then return (True , removeOwnedToken $ removeFreeToken jobs)
- else return (False, jobs)
- if not still_ok_to_release
- then return Idle
- else do
- tid <- forkIO $ do
- x <- MC.try $ releaseSemaphore sem 1
- tracedAtomically_ "post-release" $ do
- (r, jobs) <- case x of
- Left (e :: MC.SomeException) -> do
- modifyJobResources jobs_tvar \ jobs ->
- return (Just e, addToken jobs)
- Right _ -> do
- return (Nothing, Nothing)
- putTMVar threadFinished_tmvar r
- return jobs
- labelThread tid "release_thread"
- return Idle
+ then let (tok, jobs') = removeOwnedToken $ removeFreeToken jobs
+ in return (Just tok, jobs')
+ else return (Nothing, jobs)
+ case mb_tok of
+ Nothing ->
+ -- Not OK to release: there are other pending jobs that could make use of the token.
+ return Idle
+ Just tok -> do
+ tid <- forkIO $ do
+ x <- MC.try @MC.SomeException $ releaseSemaphoreToken tok
+ tracedAtomically_ "post-release" $ do
+ (r, jobs) <- case x of
+ Left (e :: MC.SomeException) -> do
+ modifyJobResources jobs_tvar \ jobs ->
+ return (Just e, addToken tok jobs)
+ Right _ -> do
+ return (Nothing, Nothing)
+ putTMVar threadFinished_tmvar r
+ return jobs
+ labelThread tid "release_thread"
+ return Idle
-- | When there are pending jobs but no free tokens,
-- spawn a thread to acquire a new token from the semaphore.
@@ -363,13 +388,14 @@ tryRelease _ _ = retry
-- | Wait for an active thread to finish. Once it finishes:
--
-- - set the 'JobserverAction' to 'Idle',
+-- - clear the 'activeChild' handle,
-- - update the number of capabilities to reflect the number
-- of owned tokens from the semaphore.
tryNoticeIdle :: JobserverOptions
- -> TVar JobResources
+ -> Jobserver
-> JobserverState
-> STM (IO JobserverState)
-tryNoticeIdle opts jobs_tvar jobserver_state
+tryNoticeIdle opts (Jobserver { jobs = jobs_tvar, activeChild = active_tvar }) jobserver_state
| Just threadFinished_tmvar <- activeThread_maybe $ jobserverAction jobserver_state
= sync_num_caps (canChangeNumCaps jobserver_state) threadFinished_tmvar
| otherwise
@@ -381,6 +407,7 @@ tryNoticeIdle opts jobs_tvar jobserver_state
sync_num_caps can_change_numcaps_tvar threadFinished_tmvar = do
mb_ex <- takeTMVar threadFinished_tmvar
for_ mb_ex MC.throwM
+ writeTVar active_tvar Nothing
Jobs { tokensOwned } <- readTVar jobs_tvar
can_change_numcaps <- readTVar can_change_numcaps_tvar
guard can_change_numcaps
@@ -404,11 +431,11 @@ tryStopThread :: TVar JobResources
-> STM (IO JobserverState)
tryStopThread jobs_tvar jsj = do
case jobserverAction jsj of
- Acquiring { activeWaitId = wait_id } -> do
+ Acquiring { activeThreadId = tid } -> do
jobs <- readTVar jobs_tvar
guard $ null (jobsWaiting jobs)
return do
- interruptWaitOnSemaphore wait_id
+ killThread tid
return $ jsj { jobserverAction = Idle }
_ -> retry
@@ -430,30 +457,38 @@ jobserverLoop opts sjs@(Jobserver { jobs = jobs_tvar })
action <- atomically $ asum $ (\x -> x s) <$>
[ tryRelease sjs
, tryAcquire opts sjs
- , tryNoticeIdle opts jobs_tvar
+ , tryNoticeIdle opts sjs
, tryStopThread jobs_tvar
]
s <- action
loop s
--- | Create a new jobserver using the given semaphore handle.
-makeJobserver :: SemaphoreName -> IO (AbstractSem, IO ())
-makeJobserver sem_name = do
- semaphore <- openSemaphore sem_name
+-- | Create a new jobserver using the given semaphore identifier.
+makeJobserver :: SemaphoreIdentifier -> IO (AbstractSem, IO ())
+makeJobserver sem_ident = do
+ semaphore <- openSemaphore sem_ident >>= either MC.throwM pure
let
init_jobs =
Jobs { tokensOwned = 1
, tokensFree = 1
, jobsWaiting = NilOL
+ , heldTokens = []
}
jobs_tvar <- newTVarIO init_jobs
+ active_tvar <- newTVarIO Nothing
let
opts = defaultJobserverOptions -- TODO: allow this to be configured
- sjs = Jobserver { jSemaphore = semaphore
- , jobs = jobs_tvar }
+ sjs = Jobserver { jSemaphore = semaphore
+ , jobs = jobs_tvar
+ , activeChild = active_tvar }
loop_finished_mvar <- newEmptyMVar
loop_tid <- forkIOWithUnmask \ unmask -> do
r <- try $ unmask $ jobserverLoop opts sjs
+ -- Always-run exit handler: any child the loop spawned is still alive
+ -- in its own thread, so drain it before touching jobs_tvar. No one
+ -- else can mutate the resources once both are dead.
+ drainActiveChild sjs
+ releaseAllHeld sjs
putMVar loop_finished_mvar $
case r of
Left e
@@ -467,8 +502,8 @@ makeJobserver sem_name = do
acquireSem = acquireJob jobs_tvar
releaseSem = releaseJob jobs_tvar
cleanupSem = do
- -- this is interruptible
- cleanupJobserver sjs
+ -- Trigger the loop's exit handler; it drains the active child and
+ -- releases all held tokens, then signals loop_finished_mvar.
killThread loop_tid
mb_ex <- takeMVar loop_finished_mvar
for_ mb_ex MC.throwM
@@ -477,12 +512,12 @@ makeJobserver sem_name = do
-- | Implement an abstract semaphore using a semaphore 'Jobserver'
-- which queries the system semaphore of the given name for resources.
-runJSemAbstractSem :: SemaphoreName -- ^ the system semaphore to use
+runJSemAbstractSem :: SemaphoreIdentifier -- ^ the semaphore identifier (from @-jsem@)
-> (AbstractSem -> IO a) -- ^ the operation to run
-- which requires a semaphore
-> IO a
-runJSemAbstractSem sem action = MC.mask \ unmask -> do
- (abs, cleanup) <- makeJobserver sem
+runJSemAbstractSem sem_ident action = MC.mask \ unmask -> do
+ (abs, cleanup) <- makeJobserver sem_ident
r <- try $ unmask $ action abs
case r of
Left (e1 :: MC.SomeException) -> do
@@ -517,8 +552,13 @@ increases the number of `free` jobs. If there are more pending jobs when the fre
is increased, the token is immediately reused (see `modifyJobResources`).
The `jobServerLoop` interacts with the system semaphore: when there are pending
-jobs, `acquireThread` blocks, waiting for a token from the semaphore. Once a
-token is obtained, it increases the owned count.
+jobs, `acquireThread` forks a child that calls the interruptible
+`waitOnSemaphore`. The child is forked in the masked state, so the only place
+an async exception can be delivered is the wait itself; once the wait returns,
+the child's STM commit always completes, recording either the new token in
+`heldTokens` or the failure exception in `threadFinished`. The (tid, tmvar)
+pair is also published in `activeChild` so the loop's exit handler can drain
+the child on shutdown even after the in-loop `JobserverState` is gone.
When GHC has free tokens (tokens from the semaphore that it is not using),
no pending jobs, and the debounce has expired, then `releaseThread` will
@@ -531,6 +571,12 @@ This second token is no longer needed, so we should cancel the wait
(as it would not be used to do any work, and not be returned until the debounce).
We only need to kill `acquireJob`, because `releaseJob` never blocks.
+Shutdown starts with `killThread loop_tid`. The loop's exit handler then
+runs `drainActiveChild` followed by `releaseAllHeld`; only then does the
+loop signal `loop_finished_mvar`. This sequence makes the heldTokens
+snapshot consistent because no other thread can mutate it once the loop and
+its child are both dead.
+
Note [Eventlog Messages for jsem]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It can be tricky to verify that the work is shared adequately across different
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -2445,6 +2445,7 @@ wWarningFlagsDeps = [minBound..maxBound] >>= \x -> case x of
Opt_WarnUnusableUnpackPragmas -> warnSpec x
Opt_WarnPatternNamespaceSpecifier -> warnSpec x
Opt_WarnUnrecognisedModifiers -> warnSpec x
+ Opt_WarnSemaphoreOpenFailure -> warnSpec x
warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)]
warningGroupsDeps = map mk warningGroups
=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -403,6 +403,7 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "DriverInstantiationNodeInDependencyGeneration" = 74284
GhcDiagnosticCode "DriverNoConfiguredLLVMToolchain" = 66599
GhcDiagnosticCode "DriverMissingLinkableForModule" = 47338
+ GhcDiagnosticCode "DriverSemaphoreOpenFailure" = 19877
-- Constraint solver diagnostic codes
GhcDiagnosticCode "BadTelescope" = 97739
=====================================
docs/users_guide/using-warnings.rst
=====================================
@@ -2721,6 +2721,23 @@ of ``-W(no-)*``.
f :: a %True -> a
g :: a %(k :: Int) -> a
+.. ghc-flag:: -Wsemaphore-open-failure
+ :shortdesc: warn when GHC cannot open the ``-jsem`` semaphore.
+ :type: dynamic
+ :reverse: -Wno-semaphore-open-failure
+ :category:
+
+ :since: 10.0.1
+
+ Warn when GHC is invoked with :ghc-flag:`-jsem` but the semaphore
+ cannot be opened (e.g. the socket does not exist, the protocol
+ version is incompatible, or a system error occurred). When this
+ occurs, GHC ignores ``-jsem`` and compiles modules sequentially.
+
+ A common cause is ``cabal-install`` and GHC being built against
+ different versions of the ``semaphore-compat`` library; upgrading
+ both to versions that use the same protocol resolves the mismatch.
+
----
If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice.
=====================================
docs/users_guide/using.rst
=====================================
@@ -797,7 +797,12 @@ There are two kinds of participants in the GHC Jobserver protocol:
Perform compilation in parallel when possible, coordinating with other
processes through the semaphore ⟨sem⟩ (specified as a string).
- Error if the semaphore doesn't exist.
+
+ If the semaphore cannot be opened (e.g. the socket does not exist
+ or its protocol version is incompatible with this GHC), GHC emits
+ a :ghc-flag:`-Wsemaphore-open-failure` warning and compiles
+ sequentially, using only the implicit token inherited from the
+ parent process.
Use of ``-jsem`` will override use of :ghc-flag:`-j[⟨n⟩]`,
and vice-versa.
=====================================
hadrian/cabal.project
=====================================
@@ -1,6 +1,7 @@
packages: ./
../utils/ghc-toolchain/
../libraries/ghc-platform/
+ ../libraries/semaphore-compat/
-- This essentially freezes the build plan for hadrian
-- It would be wise to keep this up to date with the state set in .gitlab/ci.sh.
=====================================
hadrian/hadrian.cabal
=====================================
@@ -172,6 +172,7 @@ executable hadrian
, base16-bytestring >= 0.1.1 && < 1.1.0.0
, ghc-platform
, ghc-toolchain
+ , semaphore-compat
ghc-options: -Wall
-Wincomplete-record-updates
-Wredundant-constraints
=====================================
hadrian/src/Flavour.hs
=====================================
@@ -149,10 +149,6 @@ werror =
-- unix has many unused imports
, package unix
? mconcat [arg "-Wwarn=unused-imports", arg "-Wwarn=unused-top-binds"]
- -- semaphore-compat relies on sem_getvalue as provided by unix, which is
- -- not implemented on Darwin and therefore throws a deprecation warning
- , package semaphoreCompat
- ? mconcat [arg "-Wwarn=deprecations"]
]
, builder Ghc
? package rts
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -25,6 +25,7 @@ import Utilities
import GHC.Toolchain as Toolchain hiding (HsCpp(HsCpp))
import GHC.Platform.ArchOS
import Settings.Program (ghcWithInterpreter)
+import System.Semaphore (semaphoreVersion, getSemaphoreProtocolVersion)
-- | Track this file to rebuild generated files whenever it changes.
trackGenerateHs :: Expr ()
@@ -488,6 +489,7 @@ generateSettings settingsFile = do
, ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays)
, ("Relative Global Package DB", pure rel_pkg_db)
, ("base unit-id", pure base_unit_id)
+ , ("Semaphore version", pure (show (getSemaphoreProtocolVersion semaphoreVersion)))
]
let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")"
pure $ case settings of
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -231,6 +231,10 @@ packageArgs = do
, package hpcBin
? builder (Cabal Flags) ? arg "-build-tool-depends"
+ ------------------------------ semaphore-compat ----------------------------
+ , package semaphoreCompat
+ ? builder (Cabal Flags) ? arg "-build-testing"
+
]
ghcInternalArgs :: Args
=====================================
hadrian/stack.yaml
=====================================
@@ -16,6 +16,7 @@ packages:
- '.'
- '../utils/ghc-toolchain'
- '../libraries/ghc-platform'
+- '../libraries/semaphore-compat'
nix:
enable: false
=====================================
libraries/semaphore-compat
=====================================
@@ -1 +1 @@
-Subproject commit 7929702401d49bc64d809c501ed5fe80aebc3cc1
+Subproject commit 20f7b117787fa1c11d62bc33d01cdabf9a7071bb
=====================================
testsuite/tests/diagnostic-codes/codes.stdout
=====================================
@@ -21,6 +21,7 @@
[GHC-29747] is untested (constructor = DriverMissingSafeHaskellMode)
[GHC-74284] is untested (constructor = DriverInstantiationNodeInDependencyGeneration)
[GHC-66599] is untested (constructor = DriverNoConfiguredLLVMToolchain)
+[GHC-19877] is untested (constructor = DriverSemaphoreOpenFailure)
[GHC-81325] is untested (constructor = ExpectingMoreArguments)
[GHC-78125] is untested (constructor = AmbiguityPreventsSolvingCt)
[GHC-84170] is untested (constructor = TcRnModMissingRealSrcSpan)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d6b0d41e1d764e614f1679837d38e3b…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d6b0d41e1d764e614f1679837d38e3b…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/semaphore-v2] Update to semaphore-compat 2.0.0 using v2 of the protocol
by Zubin (＠wz1000) 19 May '26
by Zubin (＠wz1000) 19 May '26
19 May '26
Zubin pushed to branch wip/semaphore-v2 at Glasgow Haskell Compiler / GHC
Commits:
b01201dd by Zubin Duggal at 2026-05-19T14:28:35+05:30
Update to semaphore-compat 2.0.0 using v2 of the protocol
On Linux and other POSIX platforms, GHC's -jsem jobserver client now
speaks v2 of the semaphore-compat protocol, which uses Unix domain
sockets in place of POSIX named semaphores. This avoids the libc-ABI
issues that affected the old implementation. Windows is unaffected
and continues to use the v1 protocol (Win32 named semaphores); its
reported protocol version remains v1.
When GHC receives a -jsem name whose protocol version it does not
support, it emits a -Wsemaphore-version-mismatch warning and falls
back to -j<N> rather than crashing. ghc --info exposes the supported
version in a new "Semaphore version" entry so cabal-install can detect
a mismatch before invoking GHC.
Users on a cabal-install that predates the v2 update will continue to
build successfully on Linux/POSIX, but will lose the cross-process
-jsem coordination and fall back to -j<N> per GHC invocation. Users
must upgrade to a cabal-install that supports protocol v2 to recover
full parallelism.
Also fix a leak in cleanupSem (#27253): cleanupSem used to snapshot
heldTokens and release them before killing the loop, while the loop's
in-flight acquire/release children could still be mutating it.
Cleanup now runs inside the loop's own exit handler, after draining
the active child via a new activeChild TVar, so the snapshot has no
concurrent mutator.
See also:
- GHC proposal amendment: https://github.com/ghc-proposals/ghc-proposals/pull/673
- cabal-install patch: https://github.com/haskell/cabal/pull/11628
- semaphore-compat MR: https://gitlab.haskell.org/ghc/semaphore-compat/-/merge_requests/8
Bump semaphore-compat submodule to 2.0.0
Fixes #25087 and #27253
- - - - -
19 changed files:
- + changelog.d/jobserver-leak-fix
- + changelog.d/semaphore-v2
- compiler/GHC/Driver/Errors/Ppr.hs
- compiler/GHC/Driver/Errors/Types.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/MakeAction.hs
- compiler/GHC/Driver/MakeSem.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Types/Error/Codes.hs
- docs/users_guide/using-warnings.rst
- docs/users_guide/using.rst
- hadrian/cabal.project
- hadrian/hadrian.cabal
- hadrian/src/Flavour.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Settings/Packages.hs
- hadrian/stack.yaml
- libraries/semaphore-compat
- testsuite/tests/diagnostic-codes/codes.stdout
Changes:
=====================================
changelog.d/jobserver-leak-fix
=====================================
@@ -0,0 +1,8 @@
+section: compiler
+issues: #27253
+mrs: !15729
+synopsis:
+ Fix a token leak in the ``-jsem`` jobserver shutdown path
+description:
+ A build interrupted by Ctrl-C while a ``-jsem`` token transfer was in
+ flight could leak that token.
=====================================
changelog.d/semaphore-v2
=====================================
@@ -0,0 +1,30 @@
+section: compiler
+issues: #25087
+mrs: !15729
+synopsis:
+ Update to semaphore-compat 2.0.0 (``-jsem`` protocol v2)
+description:
+ On Linux and other POSIX platforms, GHC's ``-jsem`` jobserver client
+ now speaks v2 of the semaphore-compat protocol, which uses Unix
+ domain sockets in place of POSIX named semaphores. This avoids the
+ libc-ABI issues that affected the old implementation. Windows is
+ unaffected and continues to use the v1 protocol (Win32 named
+ semaphores); its reported protocol version remains v1.
+
+ When GHC receives a ``-jsem`` name whose protocol version it does not
+ support, it now emits a ``-Wsemaphore-version-mismatch`` warning and
+ falls back to ``-j1`` rather than crashing. ``ghc --info`` exposes the
+ supported version in a new ``"Semaphore version"`` entry so
+ cabal-install can detect a mismatch before invoking GHC.
+
+ Users on a ``cabal-install`` that predates the v2 update will continue
+ to build successfully on Linux/POSIX, but will lose the cross-process
+ ``-jsem`` coordination and fall back to ``-j1`` per GHC invocation.
+ To recover full parallelism, upgrade to a ``cabal-install`` that
+ supports protocol v2.
+
+ See also:
+
+ - the `GHC proposal amendment <https://github.com/ghc-proposals/ghc-proposals/pull/673>`_
+ - the `cabal-install patch <https://github.com/haskell/cabal/pull/11628>`_
+ - the `semaphore-compat library MR <https://gitlab.haskell.org/ghc/semaphore-compat/-/merge_requests/8>`_
=====================================
compiler/GHC/Driver/Errors/Ppr.hs
=====================================
@@ -24,6 +24,8 @@ import GHC.Types.Hint
import GHC.Types.SrcLoc
import Data.Version
+import System.Semaphore
+ ( SemaphoreError(..), getSemaphoreProtocolVersion )
import Language.Haskell.Syntax.Decls (RuleDecl(..))
import GHC.Tc.Errors.Types (TcRnMessage)
import GHC.HsToCore.Errors.Types (DsMessage)
@@ -90,6 +92,20 @@ instance Diagnostic GhcMessage where
instance HasDefaultDiagnosticOpts DriverMessageOpts where
defaultOpts = DriverMessageOpts (defaultDiagnosticOpts @PsMessage) (defaultDiagnosticOpts @IfaceMessage)
+pprSemaphoreError :: SemaphoreError -> SDoc
+pprSemaphoreError = \case
+ SemaphoreAlreadyExists nm ->
+ text "a semaphore named" <+> quotes (text nm) <+> text "already exists"
+ SemaphoreDoesNotExist nm ->
+ text "no semaphore named" <+> quotes (text nm)
+ SemaphoreIncompatibleVersion got want ->
+ text "protocol version mismatch (got v"
+ <> int (getSemaphoreProtocolVersion got)
+ <> text ", supported v"
+ <> int (getSemaphoreProtocolVersion want) <> text ")"
+ SemaphoreOtherError ioe ->
+ text (show ioe)
+
instance Diagnostic DriverMessage where
type DiagnosticOpts DriverMessage = DriverMessageOpts
diagnosticMessage opts = \case
@@ -282,6 +298,10 @@ instance Diagnostic DriverMessage where
-> mkSimpleDecorated $
vcat [ text "The following modules are missing a linkable which is needed for creating a library:"
, nest 2 $ hcat (map ppr mods) ]
+ DriverSemaphoreOpenFailure err
+ -> mkSimpleDecorated $
+ text "Failed to open -jsem semaphore:" <+> pprSemaphoreError err <>
+ text "; ignoring -jsem and compiling sequentially."
diagnosticReason = \case
DriverUnknownMessage m
@@ -355,6 +375,8 @@ instance Diagnostic DriverMessage where
-> WarningWithoutFlag
DriverMissingLinkableForModule {}
-> ErrorWithoutFlag
+ DriverSemaphoreOpenFailure {}
+ -> WarningWithFlag Opt_WarnSemaphoreOpenFailure
diagnosticHints = \case
DriverUnknownMessage m
@@ -430,5 +452,14 @@ instance Diagnostic DriverMessage where
-> noHints
DriverMissingLinkableForModule {}
-> noHints
+ DriverSemaphoreOpenFailure (SemaphoreIncompatibleVersion received supported)
+ | received < supported
+ -> [UnknownHint (text "The parent process (e.g. cabal-install) uses an older semaphore protocol."
+ $$ text "Upgrading cabal-install may resolve this." :: SDoc)]
+ | otherwise
+ -> [UnknownHint (text "The parent process (e.g. cabal-install) uses a newer semaphore protocol."
+ $$ text "Upgrading GHC may resolve this." :: SDoc)]
+ DriverSemaphoreOpenFailure {}
+ -> noHints
diagnosticCode = constructorCode @GHC
=====================================
compiler/GHC/Driver/Errors/Types.hs
=====================================
@@ -37,6 +37,7 @@ import qualified GHC.LanguageExtensions as LangExt
import GHC.Generics ( Generic )
+import System.Semaphore ( SemaphoreError )
import GHC.Tc.Errors.Types
import GHC.Iface.Errors.Types
@@ -419,6 +420,13 @@ data DriverMessage where
DriverMissingLinkableForModule :: ![Module] -> DriverMessage
+ {-| DriverSemaphoreOpenFailure is a warning that occurs when GHC fails to
+ open the semaphore specified by @-jsem@, e.g. the socket does not
+ exist, the protocol version is incompatible, or a system error
+ occurred. GHC ignores @-jsem@ and compiles sequentially.
+ -}
+ DriverSemaphoreOpenFailure :: !SemaphoreError -> DriverMessage
+
deriving instance Generic DriverMessage
data DriverMessageOpts =
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -1115,6 +1115,7 @@ data WarningFlag =
| Opt_WarnUnusableUnpackPragmas -- ^ @since 9.14
| Opt_WarnPatternNamespaceSpecifier -- ^ @since 9.14
| Opt_WarnUnrecognisedModifiers -- ^ @since 10.0
+ | Opt_WarnSemaphoreOpenFailure -- Since 10.0.1
deriving (Eq, Ord, Show, Enum, Bounded)
-- | Return the names of a WarningFlag
@@ -1237,6 +1238,7 @@ warnFlagNames wflag = case wflag of
Opt_WarnUnusableUnpackPragmas -> "unusable-unpack-pragmas" :| []
Opt_WarnPatternNamespaceSpecifier -> "pattern-namespace-specifier" :| []
Opt_WarnUnrecognisedModifiers -> "unrecognised-modifiers" :| []
+ Opt_WarnSemaphoreOpenFailure -> "semaphore-open-failure" :| []
-- -----------------------------------------------------------------------------
-- Standard sets of warning options
@@ -1383,7 +1385,8 @@ standardWarnings -- see Note [Documenting warning flags]
Opt_WarnDeprecatedPragmas,
Opt_WarnRuleLhsEqualities,
Opt_WarnUnusableUnpackPragmas,
- Opt_WarnUnrecognisedModifiers
+ Opt_WarnUnrecognisedModifiers,
+ Opt_WarnSemaphoreOpenFailure
]
-- | Things you get with @-W@.
=====================================
compiler/GHC/Driver/MakeAction.hs
=====================================
@@ -28,6 +28,14 @@ import GHC.Driver.Errors.Types
import GHC.Driver.Messager
import GHC.Driver.MakeSem
+import System.Semaphore
+ ( SemaphoreError, SemaphoreIdentifier )
+
+import GHC.Driver.Config.Diagnostic ( initDiagOpts, initPrintConfig )
+import GHC.Driver.Errors ( printOrThrowDiagnostics )
+import GHC.Types.Error ( singleMessage )
+import GHC.Types.SrcLoc ( noSrcSpan )
+import GHC.Utils.Error ( mkPlainMsgEnvelope )
import GHC.Utils.Logger
import GHC.Utils.TmpFs
@@ -49,7 +57,7 @@ mkWorkerLimit :: DynFlags -> IO WorkerLimit
mkWorkerLimit dflags =
case parMakeCount dflags of
Nothing -> pure $ num_procs 1
- Just (ParMakeSemaphore h) -> pure (JSemLimit (SemaphoreName h))
+ Just (ParMakeSemaphore h) -> pure (JSemLimit h)
Just ParMakeNumProcessors -> num_procs <$> getNumProcessors
Just (ParMakeThisMany n) -> pure $ num_procs n
where
@@ -65,8 +73,8 @@ isWorkerLimitSequential (JSemLimit {}) = False
data WorkerLimit
= NumProcessorsLimit Int
| JSemLimit
- SemaphoreName
- -- ^ Semaphore name to use
+ SemaphoreIdentifier
+ -- ^ Semaphore identifier from @-jsem@
deriving Eq
-- | Environment used when compiling a module
@@ -122,17 +130,24 @@ runNjobsAbstractSem n_jobs action = do
resetNumCapabilities = set_num_caps n_capabilities
MC.bracket_ updNumCapabilities resetNumCapabilities $ action asem
-runWorkerLimit :: WorkerLimit -> (AbstractSem -> IO a) -> IO a
+runWorkerLimit :: Logger -> DynFlags -> WorkerLimit -> (AbstractSem -> IO a) -> IO a
#if defined(wasm32_HOST_ARCH)
-runWorkerLimit _ action = do
+runWorkerLimit _logger _dflags _ action = do
lock <- newMVar ()
action $ AbstractSem (takeMVar lock) (putMVar lock ())
#else
-runWorkerLimit worker_limit action = case worker_limit of
+runWorkerLimit logger dflags worker_limit action = case worker_limit of
NumProcessorsLimit n_jobs ->
runNjobsAbstractSem n_jobs action
- JSemLimit sem ->
- runJSemAbstractSem sem action
+ JSemLimit sem_ident -> do
+ result <- MC.try @SemaphoreError $ runJSemAbstractSem sem_ident action
+ case result of
+ Right a -> return a
+ Left err -> do
+ let diag = DriverSemaphoreOpenFailure err
+ msg = singleMessage $ mkPlainMsgEnvelope (initDiagOpts dflags) noSrcSpan diag
+ printOrThrowDiagnostics logger (initPrintConfig dflags) (initDiagOpts dflags) (GhcDriverMessage <$> msg)
+ runNjobsAbstractSem 1 action
#endif
-- | Build and run a pipeline
@@ -159,7 +174,7 @@ runParPipelines worker_limit plugin_hsc_env diag_wrapper mHscMessager all_pipeli
thread_safe_logger <- liftIO $ makeThreadSafe (hsc_logger plugin_hsc_env)
let thread_safe_hsc_env = plugin_hsc_env { hsc_logger = thread_safe_logger }
- runWorkerLimit worker_limit $ \abstract_sem -> do
+ runWorkerLimit (hsc_logger plugin_hsc_env) (hsc_dflags plugin_hsc_env) worker_limit $ \abstract_sem -> do
let env = MakeEnv { hsc_env = thread_safe_hsc_env
, withLogger = withParLog log_queue_queue_var
, compile_sem = abstract_sem
=====================================
compiler/GHC/Driver/MakeSem.hs
=====================================
@@ -9,9 +9,6 @@ module GHC.Driver.MakeSem
-- by a system semaphore (Posix/Windows)
runJSemAbstractSem
- -- * System semaphores
- , Semaphore, SemaphoreName(..)
-
-- * Abstract semaphores
, AbstractSem(..)
, withAbstractSem
@@ -46,11 +43,14 @@ import Debug.Trace
-- available from the semaphore.
data Jobserver
= Jobserver
- { jSemaphore :: !Semaphore
+ { jSemaphore :: !ClientSemaphore
-- ^ The semaphore which controls available resources
, jobs :: !(TVar JobResources)
-- ^ The currently pending jobs, and the resources
-- obtained from the semaphore
+ , activeChild :: !(TVar (Maybe (ThreadId, TMVar (Maybe MC.SomeException))))
+ -- ^ Handle on the current acquire thread (if any). The loop's exit
+ -- handler reads this to drain a still-running child on shutdown.
}
data JobserverOptions
@@ -81,6 +81,9 @@ data JobResources
, jobsWaiting :: !(OrdList (TMVar ()))
-- ^ Pending jobs waiting on a token, the job will be blocked on the TMVar so putting into
-- the TMVar will allow the job to continue.
+ , heldTokens :: [SemaphoreToken]
+ -- ^ Actual semaphore tokens (for release/cleanup).
+ -- Length should equal tokensOwned - 1 (the implicit token has no SemaphoreToken).
}
instance Outputable JobResources where
@@ -93,9 +96,9 @@ instance Outputable JobResources where
] )
-- | Add one new token.
-addToken :: JobResources -> JobResources
-addToken jobs@( Jobs { tokensOwned = owned, tokensFree = free })
- = jobs { tokensOwned = owned + 1, tokensFree = free + 1 }
+addToken :: SemaphoreToken -> JobResources -> JobResources
+addToken tok jobs@( Jobs { tokensOwned = owned, tokensFree = free, heldTokens = toks })
+ = jobs { tokensOwned = owned + 1, tokensFree = free + 1, heldTokens = tok : toks }
-- | Free one token.
addFreeToken :: JobResources -> JobResources
@@ -111,12 +114,14 @@ removeFreeToken jobs@( Jobs { tokensFree = free })
(text "removeFreeToken:" <+> ppr free)
$ jobs { tokensFree = free - 1 }
--- | Return one owned token.
-removeOwnedToken :: JobResources -> JobResources
-removeOwnedToken jobs@( Jobs { tokensOwned = owned })
+-- | Return one owned token, extracting the 'SemaphoreToken' for release.
+removeOwnedToken :: JobResources -> (SemaphoreToken, JobResources)
+removeOwnedToken jobs@( Jobs { tokensOwned = owned, heldTokens = toks })
= assertPpr (owned > 1)
(text "removeOwnedToken:" <+> ppr owned)
- $ jobs { tokensOwned = owned - 1 }
+ $ case toks of
+ (t:rest) -> (t, jobs { tokensOwned = owned - 1, heldTokens = rest })
+ [] -> panic "removeOwnedToken: no held tokens"
-- | Add one new job to the end of the list of pending jobs.
addJob :: TMVar () -> JobResources -> JobResources
@@ -143,7 +148,7 @@ data JobserverAction
= Idle
-- | A thread is waiting for a token on the semaphore.
| Acquiring
- { activeWaitId :: WaitId
+ { activeThreadId :: ThreadId
, threadFinished :: TMVar (Maybe MC.SomeException) }
-- | Retrieve the 'TMVar' that signals if the current thread has finished,
@@ -189,17 +194,30 @@ releaseJob jobs_tvar = do
return ((), addFreeToken jobs)
--- | Release all tokens owned from the semaphore (to clean up
--- the jobserver at the end).
-cleanupJobserver :: Jobserver -> IO ()
-cleanupJobserver (Jobserver { jSemaphore = sem
- , jobs = jobs_tvar })
- = do
- Jobs { tokensOwned = owned } <- readTVarIO jobs_tvar
- let toks_to_release = owned - 1
- -- Subtract off the implicit token: whoever spawned the ghc process
- -- in the first place is responsible for that token.
- releaseSemaphore sem toks_to_release
+-- | Kill the current acquire thread, if any, and wait for it to exit.
+--
+-- Called from the jobserver loop's exit handler, which runs masked.
+-- Relies on the invariant from 'acquireThread' that a forked child
+-- always fills its 'threadFinished' TMVar before it dies; this is what
+-- lets the 'takeTMVar' below terminate after the 'killThread'.
+drainActiveChild :: Jobserver -> IO ()
+drainActiveChild (Jobserver { activeChild = active_tvar }) = do
+ mb <- readTVarIO active_tvar
+ for_ mb $ \(tid, tmv) -> do
+ killThread tid
+ void $ atomically (takeTMVar tmv)
+ atomically $ writeTVar active_tvar Nothing
+
+-- | Release every token currently in 'heldTokens'.
+--
+-- Called from the jobserver loop's exit handler, which runs masked,
+-- after 'drainActiveChild': no other thread is mutating 'JobResources'
+-- at this point.
+releaseAllHeld :: Jobserver -> IO ()
+releaseAllHeld (Jobserver { jobs = jobs_tvar }) = do
+ Jobs { heldTokens = toks } <- readTVarIO jobs_tvar
+ forM_ toks $ \t ->
+ void $ MC.try @MC.SomeException (releaseSemaphoreToken t)
-- | Dispatch the available tokens acquired from the semaphore
-- to the pending jobs in the job server.
@@ -252,7 +270,7 @@ tracedAtomically origin act = do
return a
renderJobResources :: String -> JobResources -> String
-renderJobResources origin (Jobs own free pending) = showSDocUnsafe $ renderJSON $
+renderJobResources origin (Jobs own free pending _heldToks) = showSDocUnsafe $ renderJSON $
JSObject [ ("name", JSString origin)
, ("owned", JSInt own)
, ("free", JSInt free)
@@ -262,61 +280,68 @@ renderJobResources origin (Jobs own free pending) = showSDocUnsafe $ renderJSON
-- | Spawn a new thread that waits on the semaphore in order to acquire
-- an additional token.
+--
+-- The child is forked masked so the only async-exception delivery point
+-- is the interruptible 'waitOnSemaphore'; the STM commit afterwards then
+-- always runs to completion, so 'threadFinished' is always filled.
+--
+-- The (tid, threadFinished) pair is also published to 'activeChild' so
+-- shutdown can drain the child even after the in-loop 'JobserverState'
+-- is gone.
acquireThread :: Jobserver -> IO JobserverAction
-acquireThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do
+acquireThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar, activeChild = active_tvar }) = do
threadFinished_tmvar <- newEmptyTMVarIO
- let
- wait_result_action :: Either MC.SomeException Bool -> IO ()
- wait_result_action wait_res =
+ tid <- MC.mask_ $ do
+ tid <- forkIO $ do
+ wait_res <- MC.try @_ @MC.SomeException $ waitOnSemaphore sem
tracedAtomically_ "acquire_thread" do
(r, jb) <- case wait_res of
Left (e :: MC.SomeException) -> do
return $ (Just e, Nothing)
- Right success -> do
- if success
- then do
- modifyJobResources jobs_tvar \ jobs ->
- return (Nothing, addToken jobs)
- else
- return (Nothing, Nothing)
+ Right tok -> do
+ modifyJobResources jobs_tvar \ jobs ->
+ return (Nothing, addToken tok jobs)
putTMVar threadFinished_tmvar r
return jb
- wait_id <- forkWaitOnSemaphoreInterruptible sem wait_result_action
- labelThread (waitingThreadId wait_id) "acquire_thread"
- return $ Acquiring { activeWaitId = wait_id
+ atomically $ writeTVar active_tvar (Just (tid, threadFinished_tmvar))
+ return tid
+ labelThread tid "acquire_thread"
+ return $ Acquiring { activeThreadId = tid
, threadFinished = threadFinished_tmvar }
-- | Spawn a thread to release ownership of one resource from the semaphore,
-- provided we have spare resources and no pending jobs.
releaseThread :: Jobserver -> IO JobserverAction
-releaseThread (Jobserver { jSemaphore = sem, jobs = jobs_tvar }) = do
+releaseThread (Jobserver { jobs = jobs_tvar }) = do
threadFinished_tmvar <- newEmptyTMVarIO
MC.mask_ do
-- Pre-release the resource so that another thread doesn't take control of it
-- just as we release the lock on the semaphore.
- still_ok_to_release
+ mb_tok
<- tracedAtomically "pre_release" $
modifyJobResources jobs_tvar \ jobs ->
if guardRelease jobs
- -- TODO: should this also debounce?
- then return (True , removeOwnedToken $ removeFreeToken jobs)
- else return (False, jobs)
- if not still_ok_to_release
- then return Idle
- else do
- tid <- forkIO $ do
- x <- MC.try $ releaseSemaphore sem 1
- tracedAtomically_ "post-release" $ do
- (r, jobs) <- case x of
- Left (e :: MC.SomeException) -> do
- modifyJobResources jobs_tvar \ jobs ->
- return (Just e, addToken jobs)
- Right _ -> do
- return (Nothing, Nothing)
- putTMVar threadFinished_tmvar r
- return jobs
- labelThread tid "release_thread"
- return Idle
+ then let (tok, jobs') = removeOwnedToken $ removeFreeToken jobs
+ in return (Just tok, jobs')
+ else return (Nothing, jobs)
+ case mb_tok of
+ Nothing ->
+ -- Not OK to release: there are other pending jobs that could make use of the token.
+ return Idle
+ Just tok -> do
+ tid <- forkIO $ do
+ x <- MC.try @MC.SomeException $ releaseSemaphoreToken tok
+ tracedAtomically_ "post-release" $ do
+ (r, jobs) <- case x of
+ Left (e :: MC.SomeException) -> do
+ modifyJobResources jobs_tvar \ jobs ->
+ return (Just e, addToken tok jobs)
+ Right _ -> do
+ return (Nothing, Nothing)
+ putTMVar threadFinished_tmvar r
+ return jobs
+ labelThread tid "release_thread"
+ return Idle
-- | When there are pending jobs but no free tokens,
-- spawn a thread to acquire a new token from the semaphore.
@@ -363,13 +388,14 @@ tryRelease _ _ = retry
-- | Wait for an active thread to finish. Once it finishes:
--
-- - set the 'JobserverAction' to 'Idle',
+-- - clear the 'activeChild' handle,
-- - update the number of capabilities to reflect the number
-- of owned tokens from the semaphore.
tryNoticeIdle :: JobserverOptions
- -> TVar JobResources
+ -> Jobserver
-> JobserverState
-> STM (IO JobserverState)
-tryNoticeIdle opts jobs_tvar jobserver_state
+tryNoticeIdle opts (Jobserver { jobs = jobs_tvar, activeChild = active_tvar }) jobserver_state
| Just threadFinished_tmvar <- activeThread_maybe $ jobserverAction jobserver_state
= sync_num_caps (canChangeNumCaps jobserver_state) threadFinished_tmvar
| otherwise
@@ -381,6 +407,7 @@ tryNoticeIdle opts jobs_tvar jobserver_state
sync_num_caps can_change_numcaps_tvar threadFinished_tmvar = do
mb_ex <- takeTMVar threadFinished_tmvar
for_ mb_ex MC.throwM
+ writeTVar active_tvar Nothing
Jobs { tokensOwned } <- readTVar jobs_tvar
can_change_numcaps <- readTVar can_change_numcaps_tvar
guard can_change_numcaps
@@ -404,11 +431,11 @@ tryStopThread :: TVar JobResources
-> STM (IO JobserverState)
tryStopThread jobs_tvar jsj = do
case jobserverAction jsj of
- Acquiring { activeWaitId = wait_id } -> do
+ Acquiring { activeThreadId = tid } -> do
jobs <- readTVar jobs_tvar
guard $ null (jobsWaiting jobs)
return do
- interruptWaitOnSemaphore wait_id
+ killThread tid
return $ jsj { jobserverAction = Idle }
_ -> retry
@@ -430,30 +457,38 @@ jobserverLoop opts sjs@(Jobserver { jobs = jobs_tvar })
action <- atomically $ asum $ (\x -> x s) <$>
[ tryRelease sjs
, tryAcquire opts sjs
- , tryNoticeIdle opts jobs_tvar
+ , tryNoticeIdle opts sjs
, tryStopThread jobs_tvar
]
s <- action
loop s
--- | Create a new jobserver using the given semaphore handle.
-makeJobserver :: SemaphoreName -> IO (AbstractSem, IO ())
-makeJobserver sem_name = do
- semaphore <- openSemaphore sem_name
+-- | Create a new jobserver using the given semaphore identifier.
+makeJobserver :: SemaphoreIdentifier -> IO (AbstractSem, IO ())
+makeJobserver sem_ident = do
+ semaphore <- openSemaphore sem_ident >>= either MC.throwM pure
let
init_jobs =
Jobs { tokensOwned = 1
, tokensFree = 1
, jobsWaiting = NilOL
+ , heldTokens = []
}
jobs_tvar <- newTVarIO init_jobs
+ active_tvar <- newTVarIO Nothing
let
opts = defaultJobserverOptions -- TODO: allow this to be configured
- sjs = Jobserver { jSemaphore = semaphore
- , jobs = jobs_tvar }
+ sjs = Jobserver { jSemaphore = semaphore
+ , jobs = jobs_tvar
+ , activeChild = active_tvar }
loop_finished_mvar <- newEmptyMVar
loop_tid <- forkIOWithUnmask \ unmask -> do
r <- try $ unmask $ jobserverLoop opts sjs
+ -- Always-run exit handler: any child the loop spawned is still alive
+ -- in its own thread, so drain it before touching jobs_tvar. No one
+ -- else can mutate the resources once both are dead.
+ drainActiveChild sjs
+ releaseAllHeld sjs
putMVar loop_finished_mvar $
case r of
Left e
@@ -467,8 +502,8 @@ makeJobserver sem_name = do
acquireSem = acquireJob jobs_tvar
releaseSem = releaseJob jobs_tvar
cleanupSem = do
- -- this is interruptible
- cleanupJobserver sjs
+ -- Trigger the loop's exit handler; it drains the active child and
+ -- releases all held tokens, then signals loop_finished_mvar.
killThread loop_tid
mb_ex <- takeMVar loop_finished_mvar
for_ mb_ex MC.throwM
@@ -477,12 +512,12 @@ makeJobserver sem_name = do
-- | Implement an abstract semaphore using a semaphore 'Jobserver'
-- which queries the system semaphore of the given name for resources.
-runJSemAbstractSem :: SemaphoreName -- ^ the system semaphore to use
+runJSemAbstractSem :: SemaphoreIdentifier -- ^ the semaphore identifier (from @-jsem@)
-> (AbstractSem -> IO a) -- ^ the operation to run
-- which requires a semaphore
-> IO a
-runJSemAbstractSem sem action = MC.mask \ unmask -> do
- (abs, cleanup) <- makeJobserver sem
+runJSemAbstractSem sem_ident action = MC.mask \ unmask -> do
+ (abs, cleanup) <- makeJobserver sem_ident
r <- try $ unmask $ action abs
case r of
Left (e1 :: MC.SomeException) -> do
@@ -517,8 +552,13 @@ increases the number of `free` jobs. If there are more pending jobs when the fre
is increased, the token is immediately reused (see `modifyJobResources`).
The `jobServerLoop` interacts with the system semaphore: when there are pending
-jobs, `acquireThread` blocks, waiting for a token from the semaphore. Once a
-token is obtained, it increases the owned count.
+jobs, `acquireThread` forks a child that calls the interruptible
+`waitOnSemaphore`. The child is forked in the masked state, so the only place
+an async exception can be delivered is the wait itself; once the wait returns,
+the child's STM commit always completes, recording either the new token in
+`heldTokens` or the failure exception in `threadFinished`. The (tid, tmvar)
+pair is also published in `activeChild` so the loop's exit handler can drain
+the child on shutdown even after the in-loop `JobserverState` is gone.
When GHC has free tokens (tokens from the semaphore that it is not using),
no pending jobs, and the debounce has expired, then `releaseThread` will
@@ -531,6 +571,12 @@ This second token is no longer needed, so we should cancel the wait
(as it would not be used to do any work, and not be returned until the debounce).
We only need to kill `acquireJob`, because `releaseJob` never blocks.
+Shutdown starts with `killThread loop_tid`. The loop's exit handler then
+runs `drainActiveChild` followed by `releaseAllHeld`; only then does the
+loop signal `loop_finished_mvar`. This sequence makes the heldTokens
+snapshot consistent because no other thread can mutate it once the loop and
+its child are both dead.
+
Note [Eventlog Messages for jsem]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It can be tricky to verify that the work is shared adequately across different
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -2445,6 +2445,7 @@ wWarningFlagsDeps = [minBound..maxBound] >>= \x -> case x of
Opt_WarnUnusableUnpackPragmas -> warnSpec x
Opt_WarnPatternNamespaceSpecifier -> warnSpec x
Opt_WarnUnrecognisedModifiers -> warnSpec x
+ Opt_WarnSemaphoreOpenFailure -> warnSpec x
warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)]
warningGroupsDeps = map mk warningGroups
=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -403,6 +403,7 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "DriverInstantiationNodeInDependencyGeneration" = 74284
GhcDiagnosticCode "DriverNoConfiguredLLVMToolchain" = 66599
GhcDiagnosticCode "DriverMissingLinkableForModule" = 47338
+ GhcDiagnosticCode "DriverSemaphoreOpenFailure" = 19877
-- Constraint solver diagnostic codes
GhcDiagnosticCode "BadTelescope" = 97739
=====================================
docs/users_guide/using-warnings.rst
=====================================
@@ -2721,6 +2721,23 @@ of ``-W(no-)*``.
f :: a %True -> a
g :: a %(k :: Int) -> a
+.. ghc-flag:: -Wsemaphore-open-failure
+ :shortdesc: warn when GHC cannot open the ``-jsem`` semaphore.
+ :type: dynamic
+ :reverse: -Wno-semaphore-open-failure
+ :category:
+
+ :since: 10.0.1
+
+ Warn when GHC is invoked with :ghc-flag:`-jsem` but the semaphore
+ cannot be opened (e.g. the socket does not exist, the protocol
+ version is incompatible, or a system error occurred). When this
+ occurs, GHC ignores ``-jsem`` and compiles modules sequentially.
+
+ A common cause is ``cabal-install`` and GHC being built against
+ different versions of the ``semaphore-compat`` library; upgrading
+ both to versions that use the same protocol resolves the mismatch.
+
----
If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice.
=====================================
docs/users_guide/using.rst
=====================================
@@ -797,7 +797,12 @@ There are two kinds of participants in the GHC Jobserver protocol:
Perform compilation in parallel when possible, coordinating with other
processes through the semaphore ⟨sem⟩ (specified as a string).
- Error if the semaphore doesn't exist.
+
+ If the semaphore cannot be opened (e.g. the socket does not exist
+ or its protocol version is incompatible with this GHC), GHC emits
+ a :ghc-flag:`-Wsemaphore-open-failure` warning and compiles
+ sequentially, using only the implicit token inherited from the
+ parent process.
Use of ``-jsem`` will override use of :ghc-flag:`-j[⟨n⟩]`,
and vice-versa.
=====================================
hadrian/cabal.project
=====================================
@@ -1,6 +1,7 @@
packages: ./
../utils/ghc-toolchain/
../libraries/ghc-platform/
+ ../libraries/semaphore-compat/
-- This essentially freezes the build plan for hadrian
-- It would be wise to keep this up to date with the state set in .gitlab/ci.sh.
=====================================
hadrian/hadrian.cabal
=====================================
@@ -172,6 +172,7 @@ executable hadrian
, base16-bytestring >= 0.1.1 && < 1.1.0.0
, ghc-platform
, ghc-toolchain
+ , semaphore-compat
ghc-options: -Wall
-Wincomplete-record-updates
-Wredundant-constraints
=====================================
hadrian/src/Flavour.hs
=====================================
@@ -149,10 +149,6 @@ werror =
-- unix has many unused imports
, package unix
? mconcat [arg "-Wwarn=unused-imports", arg "-Wwarn=unused-top-binds"]
- -- semaphore-compat relies on sem_getvalue as provided by unix, which is
- -- not implemented on Darwin and therefore throws a deprecation warning
- , package semaphoreCompat
- ? mconcat [arg "-Wwarn=deprecations"]
]
, builder Ghc
? package rts
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -25,6 +25,7 @@ import Utilities
import GHC.Toolchain as Toolchain hiding (HsCpp(HsCpp))
import GHC.Platform.ArchOS
import Settings.Program (ghcWithInterpreter)
+import System.Semaphore (semaphoreVersion, getSemaphoreProtocolVersion)
-- | Track this file to rebuild generated files whenever it changes.
trackGenerateHs :: Expr ()
@@ -488,6 +489,7 @@ generateSettings settingsFile = do
, ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays)
, ("Relative Global Package DB", pure rel_pkg_db)
, ("base unit-id", pure base_unit_id)
+ , ("Semaphore version", pure (show (getSemaphoreProtocolVersion semaphoreVersion)))
]
let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")"
pure $ case settings of
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -231,6 +231,10 @@ packageArgs = do
, package hpcBin
? builder (Cabal Flags) ? arg "-build-tool-depends"
+ ------------------------------ semaphore-compat ----------------------------
+ , package semaphoreCompat
+ ? builder (Cabal Flags) ? arg "-build-testing"
+
]
ghcInternalArgs :: Args
=====================================
hadrian/stack.yaml
=====================================
@@ -16,6 +16,7 @@ packages:
- '.'
- '../utils/ghc-toolchain'
- '../libraries/ghc-platform'
+- '../libraries/semaphore-compat'
nix:
enable: false
=====================================
libraries/semaphore-compat
=====================================
@@ -1 +1 @@
-Subproject commit 7929702401d49bc64d809c501ed5fe80aebc3cc1
+Subproject commit 2453a03c00e25e30e321816d53c8dbdb113de08b
=====================================
testsuite/tests/diagnostic-codes/codes.stdout
=====================================
@@ -21,6 +21,8 @@
[GHC-29747] is untested (constructor = DriverMissingSafeHaskellMode)
[GHC-74284] is untested (constructor = DriverInstantiationNodeInDependencyGeneration)
[GHC-66599] is untested (constructor = DriverNoConfiguredLLVMToolchain)
+[GHC-56206] is untested (constructor = DriverSemaphoreVersionMismatch)
+[GHC-19877] is untested (constructor = DriverSemaphoreOpenFailure)
[GHC-81325] is untested (constructor = ExpectingMoreArguments)
[GHC-78125] is untested (constructor = AmbiguityPreventsSolvingCt)
[GHC-84170] is untested (constructor = TcRnModMissingRealSrcSpan)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b01201dd5798de0a008cec4d13fdb0c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b01201dd5798de0a008cec4d13fdb0c…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Do not use mkCast during typechecking
by Marge Bot (＠marge-bot) 19 May '26
by Marge Bot (＠marge-bot) 19 May '26
19 May '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
e8697579 by Simon Peyton Jones at 2026-05-19T03:00:46-04:00
Do not use mkCast during typechecking
This commit fixes #27219. The problem was that the typechecker was using
`mkCast`, whose assertion checks legitimately fail when applied to types
that contain unification variables.
- - - - -
749ec972 by Simon Peyton Jones at 2026-05-19T03:00:46-04:00
Major refactor of the Simplifier
The main payload of this patch is to refactor the Simplifer to avoid
repeated simplification when using Plan (AFTER) for rule rewrites.
The need for this was shown up by #26989.
See Note [Avoid repeated simplification] in GHC.Core.Opt.Simplify.Iteration.
Related refactoring:
* Refactor the two fields `sc_dup` and `sc_env` in `ApplyToVal` into one, `sc_env`.
Reason: the envt is irrelevant in the "simplified" case, so the data type describes
the possiblitiies much more accurately now.
* Some refactoring in `knownCon` to split off `wrapDataConFloats`.
* Refactor `lookupRule` and its auxiliary functions to return `RuleMatch`,
a new data type. See Note [data RuleMatch] in GHC.Core. Ditto for BuiltinRule.
This RuleMatch returns fragments of the target in rm_args and rm_floats,
leaving `rm_rhs` to be the stuff from the RULE itself.
Doing this has routine consequences in GHC.Core.Opt.ConstantFold. Many changes
there but all routine.
* When doing occurrence analysis on RULEs, make the occ-info on the rule
binders relate just to the RHS, not the LHS. See (OUR1) in
Note Note [OccInfo in unfoldings and rules]
This means that Lint must not complain about the fact that the patterns
in the RULE mentions binders that are marked dead.
See Note [Dead occurrences] in GHC.Core.Lint.
I changed the Core pretty-printer so that it didn't suppress dead binders,
else I can't see those binders in RULEs. That led to quite a lot of testsuite wibbles.
* Refactor FloatBinds, so that it is used both by
`exprIsConApp_mabye` and by `lookupRule`
* Move the definition of FloatBinds out of GHc.Core.Make, into GHC.Core.
* Add FloatTick as an extra constructor.
* Refactor `lookupRule` to use `FloatBinds` instead of `BindWrapper`.
This refactor just shares more code.
(Rename GHC.Core.Opt.FloatOut.FloatBinds to FloatLets, to avoid gratuitious
name clash with GHC.Core.FloatBinds.)
Corecion optimisation
* In simpleOpt, when composing coercions, call new function `optTransCo`.
This is much lighter weight than full blown coercion optimisation.
* Make `GHC.Core.Opt.Arity.pushCoValArg` and `pushCoTyArg` return the
coercionLKind of the coercion. This saves recomputing that coercionLKind
at the key call sites in GHC.Core.Opt.Simplify.Iteration.pushCast.
* Rename `addCoerce` in GHC.Core.Simplify.Iteration to become `pushCast`.
* In the `ApplyToVal` case of `pushCast` we had a very unsavoury call to `simplArg`.
I eliminated it by adding a field `sc_cast` to `ApplyToVal` that records any
pending casts. Much nicer now. See Note [The sc_cast field of ApplyToVal].
* Don't optimise coercions if the type-substitution is empty.
See Note [Optimising coercions] in GHC.Core.Opt.Simplify.Iteration.
The fix for #26838 is dramatic. For the test in perf/compiler/T26839 we have
Compiler allocs: Before: 7,363M
After: 688M
Compile time goes down generally. Here are compiler-alloc changes
over 0.5%:
CoOpt_Read(normal) 729,184,920 -0.7%
CoOpt_Singletons(normal) 666,916,960 -4.6% GOOD
LargeRecord(normal) 1,227,056,876 +1.1%
T12227(normal) 256,827,604 -4.6% GOOD
T12425(optasm) 76,879,410 -0.8%
T12545(normal) 787,826,918 -10.8% GOOD
T12707(normal) 775,186,464 -0.9%
T13253(normal) 318,599,596 -0.8%
T14766(normal) 685,857,320 -1.0%
T15304(normal) 1,123,333,422 -2.2%
T15630(normal) 123,142,330 -2.6%
T15630a(normal) 123,092,100 -2.6%
T15703(normal) 299,751,682 -2.9% GOOD
T17516(normal) 964,072,280 +1.0%
T18223(normal) 367,016,820 -6.2% GOOD
T18730(optasm) 130,643,770 -3.3% GOOD
T20261(normal) 535,608,584 -0.7%
T21839c(normal) 340,340,436 -0.9%
T24984(normal) 85,568,392 -1.9%
T3064(normal) 174,631,992 -1.2%
T3294(normal) 1,215,886,432 -0.7%
T5030(normal) 141,449,704 -17.2% GOOD
T5321Fun(normal) 258,484,744 -1.9%
T8095(normal) 770,532,232 -2.7%
T9630(normal) 858,423,408 -14.5% GOOD
T9872c(normal) 1,591,709,448 +0.7%
info_table_map_perf(normal) 19,700,614,458 -1.3%
geo. mean -0.7%
minimum -17.2%
maximum +1.1%
However, strangely there seems to be a 5.0% increase in CoOpt_Read in
the x86_64-linux-fedora43-validate+debug_info+ubsan job, although
there generally a /decrease/ in this test in other builds. The baseline
value looks strange. Anyway I'll just accept it.
Metric Decrease:
CoOpt_Singletons
T12227
T12545
T15703
T18223
T18730
T21839c
T5030
T9630
Metric Increase:
CoOpt_Read
- - - - -
145b7a5b by fendor at 2026-05-19T03:00:47-04:00
Fix regression T27202: `:load` and `:add` work in GHCi
To fix the regression there are conceptually two major things that we
fix:
* We don't remove the `importDirs` from `interactive-session`
* When `:add`ing a module, we don't try to find them via PackageImports
* The PackageImport is wrong as we can't know the package-name at
this stage in ghc/UI.hs
What does it mean to not remove the `importDirs` from
`interactive-session`?
It means that, given some initial `DynFlags`, we will use those
`importDirs` in `interactive-session`.
The initial `DynFlags`, however, depend on how you initialise the GHC
session.
For a simple session, initialised by
ghc -isrc -this-unit-id main
It is simple, just use the `DynFlags` given on the cli.
Thus, `main` and `interactive-session` will have the same `DynFlags`,
except for the `homeUnitId` and `interactive-session` depends on `main`
by construction of the GHCi session.
What about a multiple home unit session, though?
ghc -unit @unit1 -unit @unit2
What are the `DynFlags` in this cli invocation? It shouldn't be either
`@unti1` nor `@unit2`, as the order shouldn't matter or any other
implicit condition.
For consistency, we decide that the initial `DynFlags` are the top
`DynFlags` on the cli, ignoring `-unit` flags.
Thus, in this example, there are no `importsDirs` regardless of what we
might find in `@unit1` and `@unit2`.
But in this invocation:
ghc -isrc -unit @unit1 -unit @unit2
The `interactive-session` will have the `importsDirs` `src`.
Note, `-isrc` will be inherited in `@unit1` and `@unit2`, so you need to
explicitly use `-i` to clear the `importsDirs`, in order to avoid
accidentally adding `src` as an import directory to all other home
units.
This fix has been made possible by the improvements introduced in
!15888, which avoids ambiguity when a home unit shares the `importsDirs`
with the `interactive-session`, on top of being much faster for multiple
home units.
Adds regression tests for T27202 for `:load`ing and `:add`ing modules
that are located in import directories.
- - - - -
c6cc02bb by fendor at 2026-05-19T03:00:47-04:00
Use home unit package db stacks in GHCi prompt and session unit
In order to import modules from home unit dependencies (e.g., `Data.Map`),
the ghci prompt unit needs to populate its `UnitState`.
This is tricky to handle correctly, which `PackageDBFlag`s should we use
to populate the `UnitState`?
We decide, the most intuitive solution for users is to depend on all
`PackageDBFlag`s, so that any dependency can be imported in GHCi.
This assumes consistency in the `PackageDBFlag`s, so no two home units
specify `PackageDBFlag`s that are inconsistent with each other.
We could simply concat all the `PackageDBFlag`s of the existing home
units, but later `PackageDBFlag`s shadow earlier ones, leading to the
last processed home units' `PackageDBFlag`s to shadow the earlier ones.
This is hard to fix, we need to give users the capability to provide ghc
options for the ghci prompt home unit.
However, as this is considerably more work, we decided on an
approximation that should work out most of the time.
Package Db stacks in cabal and stack follow a certain structure:
-no-user-package-db > -package-db $cabal-store > -package-db $local-db
The first two arguments are always the same, namely the
`-no-user-package-db` and `-package-db`.
We compute the longest common prefix over all home units, and use that
as the start of the package db stack. Then, over the rest of the
`PackageDBFlag`s, we simply take the union and append them to our
initial stack.
We assume, that the rest of package dbs only defines very few, "local"
units that are usually not shadowing each other.
This allows us to get a relatively consistent package database stack for
the ghci prompt home unit.
Similar reasoning applies to the session unit in order to add modules to
the session and have dependencies available in the module.
We do something similar for `-package` flags, to make sure only the
correct units are actually visible in the ghci session.
This time, we simply take the union of all `PackageFlag`s, allowing us
to import modules from the home unit dependencies.
In the future, it would be beneficial to allow the user to provide the
exact ghc options to control the visibilities. For now, this will have
to do.
- - - - -
08ca666b by Wen Kokke at 2026-05-19T03:00:48-04:00
rts: Add IPE event class for -l
This commit adds a new IPE event class to the -l RTS flag.
Previously, IPE events were enabled unconditionally.
However, the IPE events can easily grow to hundreds or thousands of megabytes.
With the new event class you can pass, e.g., -l-I to disable IPE events.
- - - - -
b8fdb837 by Wen Kokke at 2026-05-19T03:00:48-04:00
ghc-internal: Add TraceFlags.traceIPE
- - - - -
94f7e58f by Wen Kokke at 2026-05-19T03:00:48-04:00
testsuite: Add test for TraceFlags.traceIpe
- - - - -
1408aa19 by Wen Kokke at 2026-05-19T03:00:48-04:00
ghc-internal: Add DebugFlags.ipe
- - - - -
390d4e33 by Wen Kokke at 2026-05-19T03:00:48-04:00
testsuite: Add test for DebugFlags.ipe
- - - - -
0f996c4e by Duncan Coutts at 2026-05-19T03:00:49-04:00
Document removal of the signal-based interval timer
Update mentions within the RTS section of the users guide.
Add a changelog entry.
- - - - -
ecb62fa3 by Duncan Coutts at 2026-05-19T03:00:49-04:00
Fix section for an recent changelog entry
- - - - -
142 changed files:
- + changelog.d/T27202
- changelog.d/dynamic-trace-flags
- + changelog.d/ipe-event-class
- + changelog.d/no-more-timer-signal
- compiler/GHC/Core.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Coercion/Opt.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Make.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/Core/Opt/FloatIn.hs
- compiler/GHC/Core/Opt/FloatOut.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Ppr.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Data/List/SetOps.hs
- compiler/GHC/Driver/Config/Core/Lint.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/HsToCore/Pmc/Solver.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Unit/State.hs
- docs/users_guide/profiling.rst
- docs/users_guide/runtime_control.rst
- ghc/GHCi/UI.hs
- ghc/Main.hs
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
- rts/IPE.c
- rts/RtsFlags.c
- rts/Trace.c
- rts/Trace.h
- rts/include/rts/EventLogWriter.h
- rts/include/rts/Flags.h
- testsuite/tests/codeGen/should_compile/T25177.stderr
- testsuite/tests/deSugar/should_compile/T13208.stdout
- testsuite/tests/driver/fat-iface/fat014.stdout
- + testsuite/tests/ghci/prog-mhu006/Makefile
- + testsuite/tests/ghci/prog-mhu006/a/A.hs
- + testsuite/tests/ghci/prog-mhu006/all.T
- + testsuite/tests/ghci/prog-mhu006/b/B.hs
- + testsuite/tests/ghci/prog-mhu006/prog-mhu006a.script
- + testsuite/tests/ghci/prog-mhu006/prog-mhu006a.stdout
- + testsuite/tests/ghci/prog-mhu006/unitA
- + testsuite/tests/ghci/prog-mhu006/unitB
- testsuite/tests/ghci/prog018/prog018.stdout
- testsuite/tests/ghci/prog020/Makefile
- testsuite/tests/ghci/prog020/all.T
- testsuite/tests/ghci/prog020/ghci.prog020.script → testsuite/tests/ghci/prog020/ghci.prog020a.script
- testsuite/tests/ghci/prog020/ghci.prog020.stderr → testsuite/tests/ghci/prog020/ghci.prog020a.stderr
- testsuite/tests/ghci/prog020/ghci.prog020.stdout → testsuite/tests/ghci/prog020/ghci.prog020a.stdout
- + testsuite/tests/ghci/prog020/ghci.prog020b.script
- + testsuite/tests/ghci/prog020/ghci.prog020b.stderr
- + testsuite/tests/ghci/prog020/ghci.prog020b.stdout
- + testsuite/tests/ghci/prog023/Makefile
- + testsuite/tests/ghci/prog023/all.T
- + testsuite/tests/ghci/prog023/prog023a.script
- + testsuite/tests/ghci/prog023/prog023a.stdout
- + testsuite/tests/ghci/prog023/prog023b.script
- + testsuite/tests/ghci/prog023/prog023b.stdout
- + testsuite/tests/ghci/prog023/src/A.hs
- + testsuite/tests/ghci/prog024/Makefile
- + testsuite/tests/ghci/prog024/all.T
- + testsuite/tests/ghci/prog024/prog024a.script
- + testsuite/tests/ghci/prog024/prog024a.stdout
- + testsuite/tests/ghci/prog024/prog024b.script
- + testsuite/tests/ghci/prog024/prog024b.stdout
- + testsuite/tests/ghci/prog024/prog024c.script
- + testsuite/tests/ghci/prog024/prog024c.stderr
- + testsuite/tests/ghci/prog024/prog024c.stdout
- + testsuite/tests/ghci/prog024/prog024d.script
- + testsuite/tests/ghci/prog024/prog024d.stderr
- + testsuite/tests/ghci/prog024/prog024d.stdout
- + testsuite/tests/ghci/prog024/prog024e.script
- + testsuite/tests/ghci/prog024/prog024e.stdout
- + testsuite/tests/ghci/prog024/prog024f.script
- + testsuite/tests/ghci/prog024/prog024f.stdout
- + testsuite/tests/ghci/prog024/src/A.hs
- + testsuite/tests/ghci/prog024/src/B.hs
- + testsuite/tests/ghci/prog025/Makefile
- + testsuite/tests/ghci/prog025/a/A.hs
- + testsuite/tests/ghci/prog025/all.T
- + testsuite/tests/ghci/prog025/prog025a.script
- + testsuite/tests/ghci/prog025/prog025a.stdout
- + testsuite/tests/ghci/prog025/prog025b.script
- + testsuite/tests/ghci/prog025/prog025b.stdout
- + testsuite/tests/ghci/prog025/testpkg/Test.hs
- + testsuite/tests/ghci/prog025/testpkg/testpkg-0.1.0.0.pkg
- + testsuite/tests/ghci/prog025/testpkg/testpkg-0.2.0.0.pkg
- + testsuite/tests/ghci/prog025/unitA
- testsuite/tests/ghci/scripts/T13997.stdout
- testsuite/tests/ghci/scripts/T1914.stdout
- testsuite/tests/ghci/scripts/T20217.stdout
- testsuite/tests/ghci/scripts/T8042.stdout
- testsuite/tests/ghci/scripts/T8042recomp.stdout
- testsuite/tests/ghci/should_run/T10920.stderr
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/linters/notes.stdout
- testsuite/tests/numeric/should_compile/T15547.stderr
- testsuite/tests/numeric/should_compile/T20347.stderr
- testsuite/tests/numeric/should_compile/T20374.stderr
- testsuite/tests/numeric/should_compile/T20376.stderr
- + testsuite/tests/perf/compiler/T26989.hs
- + testsuite/tests/perf/compiler/T26989a.hs
- testsuite/tests/perf/compiler/all.T
- testsuite/tests/printer/T18052a.stderr
- + testsuite/tests/rts/T25275/DebugIpe.hs
- + testsuite/tests/rts/T25275/T25275_A.stdout
- + testsuite/tests/rts/T25275/T25275_B.stdout
- + testsuite/tests/rts/T25275/T25275_C.stdout
- + testsuite/tests/rts/T25275/T25275_D.stdout
- + testsuite/tests/rts/T25275/TraceIpe.hs
- + testsuite/tests/rts/T25275/all.T
- testsuite/tests/simplCore/should_compile/DsSpecPragmas.stderr
- testsuite/tests/simplCore/should_compile/RewriteHigherOrderPatterns.stderr
- testsuite/tests/simplCore/should_compile/T15205.stderr
- testsuite/tests/simplCore/should_compile/T18668.stderr
- testsuite/tests/simplCore/should_compile/T19246.stderr
- testsuite/tests/simplCore/should_compile/T19599.stderr
- testsuite/tests/simplCore/should_compile/T19599a.stderr
- testsuite/tests/simplCore/should_compile/T21917.stderr
- testsuite/tests/simplCore/should_compile/T23074.stderr
- testsuite/tests/simplCore/should_compile/T24359a.stderr
- testsuite/tests/simplCore/should_compile/T25160.stderr
- testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-32
- testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-64
- testsuite/tests/simplCore/should_compile/T26051.stderr
- testsuite/tests/simplCore/should_compile/T26116.stderr
- testsuite/tests/simplCore/should_compile/T8331.stderr
- testsuite/tests/simplCore/should_compile/T8848a.stderr
- testsuite/tests/simplCore/should_compile/spec004.stderr
- testsuite/tests/typecheck/should_compile/T13032.stderr
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/394b2187dc056a42784420ea8cb0be…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/394b2187dc056a42784420ea8cb0be…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Do not use mkCast during typechecking
by Marge Bot (＠marge-bot) 19 May '26
by Marge Bot (＠marge-bot) 19 May '26
19 May '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
9683bbbf by Simon Peyton Jones at 2026-05-18T20:36:56-04:00
Do not use mkCast during typechecking
This commit fixes #27219. The problem was that the typechecker was using
`mkCast`, whose assertion checks legitimately fail when applied to types
that contain unification variables.
- - - - -
b68e1e15 by Simon Peyton Jones at 2026-05-18T20:36:56-04:00
Major refactor of the Simplifier
The main payload of this patch is to refactor the Simplifer to avoid
repeated simplification when using Plan (AFTER) for rule rewrites.
The need for this was shown up by #26989.
See Note [Avoid repeated simplification] in GHC.Core.Opt.Simplify.Iteration.
Related refactoring:
* Refactor the two fields `sc_dup` and `sc_env` in `ApplyToVal` into one, `sc_env`.
Reason: the envt is irrelevant in the "simplified" case, so the data type describes
the possiblitiies much more accurately now.
* Some refactoring in `knownCon` to split off `wrapDataConFloats`.
* Refactor `lookupRule` and its auxiliary functions to return `RuleMatch`,
a new data type. See Note [data RuleMatch] in GHC.Core. Ditto for BuiltinRule.
This RuleMatch returns fragments of the target in rm_args and rm_floats,
leaving `rm_rhs` to be the stuff from the RULE itself.
Doing this has routine consequences in GHC.Core.Opt.ConstantFold. Many changes
there but all routine.
* When doing occurrence analysis on RULEs, make the occ-info on the rule
binders relate just to the RHS, not the LHS. See (OUR1) in
Note Note [OccInfo in unfoldings and rules]
This means that Lint must not complain about the fact that the patterns
in the RULE mentions binders that are marked dead.
See Note [Dead occurrences] in GHC.Core.Lint.
I changed the Core pretty-printer so that it didn't suppress dead binders,
else I can't see those binders in RULEs. That led to quite a lot of testsuite wibbles.
* Refactor FloatBinds, so that it is used both by
`exprIsConApp_mabye` and by `lookupRule`
* Move the definition of FloatBinds out of GHc.Core.Make, into GHC.Core.
* Add FloatTick as an extra constructor.
* Refactor `lookupRule` to use `FloatBinds` instead of `BindWrapper`.
This refactor just shares more code.
(Rename GHC.Core.Opt.FloatOut.FloatBinds to FloatLets, to avoid gratuitious
name clash with GHC.Core.FloatBinds.)
Corecion optimisation
* In simpleOpt, when composing coercions, call new function `optTransCo`.
This is much lighter weight than full blown coercion optimisation.
* Make `GHC.Core.Opt.Arity.pushCoValArg` and `pushCoTyArg` return the
coercionLKind of the coercion. This saves recomputing that coercionLKind
at the key call sites in GHC.Core.Opt.Simplify.Iteration.pushCast.
* Rename `addCoerce` in GHC.Core.Simplify.Iteration to become `pushCast`.
* In the `ApplyToVal` case of `pushCast` we had a very unsavoury call to `simplArg`.
I eliminated it by adding a field `sc_cast` to `ApplyToVal` that records any
pending casts. Much nicer now. See Note [The sc_cast field of ApplyToVal].
* Don't optimise coercions if the type-substitution is empty.
See Note [Optimising coercions] in GHC.Core.Opt.Simplify.Iteration.
The fix for #26838 is dramatic. For the test in perf/compiler/T26839 we have
Compiler allocs: Before: 7,363M
After: 688M
Compile time goes down generally. Here are compiler-alloc changes
over 0.5%:
CoOpt_Read(normal) 729,184,920 -0.7%
CoOpt_Singletons(normal) 666,916,960 -4.6% GOOD
LargeRecord(normal) 1,227,056,876 +1.1%
T12227(normal) 256,827,604 -4.6% GOOD
T12425(optasm) 76,879,410 -0.8%
T12545(normal) 787,826,918 -10.8% GOOD
T12707(normal) 775,186,464 -0.9%
T13253(normal) 318,599,596 -0.8%
T14766(normal) 685,857,320 -1.0%
T15304(normal) 1,123,333,422 -2.2%
T15630(normal) 123,142,330 -2.6%
T15630a(normal) 123,092,100 -2.6%
T15703(normal) 299,751,682 -2.9% GOOD
T17516(normal) 964,072,280 +1.0%
T18223(normal) 367,016,820 -6.2% GOOD
T18730(optasm) 130,643,770 -3.3% GOOD
T20261(normal) 535,608,584 -0.7%
T21839c(normal) 340,340,436 -0.9%
T24984(normal) 85,568,392 -1.9%
T3064(normal) 174,631,992 -1.2%
T3294(normal) 1,215,886,432 -0.7%
T5030(normal) 141,449,704 -17.2% GOOD
T5321Fun(normal) 258,484,744 -1.9%
T8095(normal) 770,532,232 -2.7%
T9630(normal) 858,423,408 -14.5% GOOD
T9872c(normal) 1,591,709,448 +0.7%
info_table_map_perf(normal) 19,700,614,458 -1.3%
geo. mean -0.7%
minimum -17.2%
maximum +1.1%
However, strangely there seems to be a 5.0% increase in CoOpt_Read in
the x86_64-linux-fedora43-validate+debug_info+ubsan job, although
there generally a /decrease/ in this test in other builds. The baseline
value looks strange. Anyway I'll just accept it.
Metric Decrease:
CoOpt_Singletons
T12227
T12545
T15703
T18223
T18730
T21839c
T5030
T9630
Metric Increase:
CoOpt_Read
- - - - -
95cb621a by fendor at 2026-05-18T20:36:57-04:00
Fix regression T27202: `:load` and `:add` work in GHCi
To fix the regression there are conceptually two major things that we
fix:
* We don't remove the `importDirs` from `interactive-session`
* When `:add`ing a module, we don't try to find them via PackageImports
* The PackageImport is wrong as we can't know the package-name at
this stage in ghc/UI.hs
What does it mean to not remove the `importDirs` from
`interactive-session`?
It means that, given some initial `DynFlags`, we will use those
`importDirs` in `interactive-session`.
The initial `DynFlags`, however, depend on how you initialise the GHC
session.
For a simple session, initialised by
ghc -isrc -this-unit-id main
It is simple, just use the `DynFlags` given on the cli.
Thus, `main` and `interactive-session` will have the same `DynFlags`,
except for the `homeUnitId` and `interactive-session` depends on `main`
by construction of the GHCi session.
What about a multiple home unit session, though?
ghc -unit @unit1 -unit @unit2
What are the `DynFlags` in this cli invocation? It shouldn't be either
`@unti1` nor `@unit2`, as the order shouldn't matter or any other
implicit condition.
For consistency, we decide that the initial `DynFlags` are the top
`DynFlags` on the cli, ignoring `-unit` flags.
Thus, in this example, there are no `importsDirs` regardless of what we
might find in `@unit1` and `@unit2`.
But in this invocation:
ghc -isrc -unit @unit1 -unit @unit2
The `interactive-session` will have the `importsDirs` `src`.
Note, `-isrc` will be inherited in `@unit1` and `@unit2`, so you need to
explicitly use `-i` to clear the `importsDirs`, in order to avoid
accidentally adding `src` as an import directory to all other home
units.
This fix has been made possible by the improvements introduced in
!15888, which avoids ambiguity when a home unit shares the `importsDirs`
with the `interactive-session`, on top of being much faster for multiple
home units.
Adds regression tests for T27202 for `:load`ing and `:add`ing modules
that are located in import directories.
- - - - -
31b708f2 by fendor at 2026-05-18T20:36:57-04:00
Use home unit package db stacks in GHCi prompt and session unit
In order to import modules from home unit dependencies (e.g., `Data.Map`),
the ghci prompt unit needs to populate its `UnitState`.
This is tricky to handle correctly, which `PackageDBFlag`s should we use
to populate the `UnitState`?
We decide, the most intuitive solution for users is to depend on all
`PackageDBFlag`s, so that any dependency can be imported in GHCi.
This assumes consistency in the `PackageDBFlag`s, so no two home units
specify `PackageDBFlag`s that are inconsistent with each other.
We could simply concat all the `PackageDBFlag`s of the existing home
units, but later `PackageDBFlag`s shadow earlier ones, leading to the
last processed home units' `PackageDBFlag`s to shadow the earlier ones.
This is hard to fix, we need to give users the capability to provide ghc
options for the ghci prompt home unit.
However, as this is considerably more work, we decided on an
approximation that should work out most of the time.
Package Db stacks in cabal and stack follow a certain structure:
-no-user-package-db > -package-db $cabal-store > -package-db $local-db
The first two arguments are always the same, namely the
`-no-user-package-db` and `-package-db`.
We compute the longest common prefix over all home units, and use that
as the start of the package db stack. Then, over the rest of the
`PackageDBFlag`s, we simply take the union and append them to our
initial stack.
We assume, that the rest of package dbs only defines very few, "local"
units that are usually not shadowing each other.
This allows us to get a relatively consistent package database stack for
the ghci prompt home unit.
Similar reasoning applies to the session unit in order to add modules to
the session and have dependencies available in the module.
We do something similar for `-package` flags, to make sure only the
correct units are actually visible in the ghci session.
This time, we simply take the union of all `PackageFlag`s, allowing us
to import modules from the home unit dependencies.
In the future, it would be beneficial to allow the user to provide the
exact ghc options to control the visibilities. For now, this will have
to do.
- - - - -
957801e6 by Wen Kokke at 2026-05-18T20:36:58-04:00
rts: Add IPE event class for -l
This commit adds a new IPE event class to the -l RTS flag.
Previously, IPE events were enabled unconditionally.
However, the IPE events can easily grow to hundreds or thousands of megabytes.
With the new event class you can pass, e.g., -l-I to disable IPE events.
- - - - -
ea7acee2 by Wen Kokke at 2026-05-18T20:36:58-04:00
ghc-internal: Add TraceFlags.traceIPE
- - - - -
3f0c18db by Wen Kokke at 2026-05-18T20:36:58-04:00
testsuite: Add test for TraceFlags.traceIpe
- - - - -
24d8fb6a by Wen Kokke at 2026-05-18T20:36:59-04:00
ghc-internal: Add DebugFlags.ipe
- - - - -
53bbeb8c by Wen Kokke at 2026-05-18T20:36:59-04:00
testsuite: Add test for DebugFlags.ipe
- - - - -
9d02df6f by Duncan Coutts at 2026-05-18T20:36:59-04:00
Document removal of the signal-based interval timer
Update mentions within the RTS section of the users guide.
Add a changelog entry.
- - - - -
394b2187 by Duncan Coutts at 2026-05-18T20:37:00-04:00
Fix section for an recent changelog entry
- - - - -
142 changed files:
- + changelog.d/T27202
- changelog.d/dynamic-trace-flags
- + changelog.d/ipe-event-class
- + changelog.d/no-more-timer-signal
- compiler/GHC/Core.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Coercion/Opt.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Make.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/Core/Opt/FloatIn.hs
- compiler/GHC/Core/Opt/FloatOut.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Ppr.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Data/List/SetOps.hs
- compiler/GHC/Driver/Config/Core/Lint.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/HsToCore/Pmc/Solver.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Unit/State.hs
- docs/users_guide/profiling.rst
- docs/users_guide/runtime_control.rst
- ghc/GHCi/UI.hs
- ghc/Main.hs
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
- rts/IPE.c
- rts/RtsFlags.c
- rts/Trace.c
- rts/Trace.h
- rts/include/rts/EventLogWriter.h
- rts/include/rts/Flags.h
- testsuite/tests/codeGen/should_compile/T25177.stderr
- testsuite/tests/deSugar/should_compile/T13208.stdout
- testsuite/tests/driver/fat-iface/fat014.stdout
- + testsuite/tests/ghci/prog-mhu006/Makefile
- + testsuite/tests/ghci/prog-mhu006/a/A.hs
- + testsuite/tests/ghci/prog-mhu006/all.T
- + testsuite/tests/ghci/prog-mhu006/b/B.hs
- + testsuite/tests/ghci/prog-mhu006/prog-mhu006a.script
- + testsuite/tests/ghci/prog-mhu006/prog-mhu006a.stdout
- + testsuite/tests/ghci/prog-mhu006/unitA
- + testsuite/tests/ghci/prog-mhu006/unitB
- testsuite/tests/ghci/prog018/prog018.stdout
- testsuite/tests/ghci/prog020/Makefile
- testsuite/tests/ghci/prog020/all.T
- testsuite/tests/ghci/prog020/ghci.prog020.script → testsuite/tests/ghci/prog020/ghci.prog020a.script
- testsuite/tests/ghci/prog020/ghci.prog020.stderr → testsuite/tests/ghci/prog020/ghci.prog020a.stderr
- testsuite/tests/ghci/prog020/ghci.prog020.stdout → testsuite/tests/ghci/prog020/ghci.prog020a.stdout
- + testsuite/tests/ghci/prog020/ghci.prog020b.script
- + testsuite/tests/ghci/prog020/ghci.prog020b.stderr
- + testsuite/tests/ghci/prog020/ghci.prog020b.stdout
- + testsuite/tests/ghci/prog023/Makefile
- + testsuite/tests/ghci/prog023/all.T
- + testsuite/tests/ghci/prog023/prog023a.script
- + testsuite/tests/ghci/prog023/prog023a.stdout
- + testsuite/tests/ghci/prog023/prog023b.script
- + testsuite/tests/ghci/prog023/prog023b.stdout
- + testsuite/tests/ghci/prog023/src/A.hs
- + testsuite/tests/ghci/prog024/Makefile
- + testsuite/tests/ghci/prog024/all.T
- + testsuite/tests/ghci/prog024/prog024a.script
- + testsuite/tests/ghci/prog024/prog024a.stdout
- + testsuite/tests/ghci/prog024/prog024b.script
- + testsuite/tests/ghci/prog024/prog024b.stdout
- + testsuite/tests/ghci/prog024/prog024c.script
- + testsuite/tests/ghci/prog024/prog024c.stderr
- + testsuite/tests/ghci/prog024/prog024c.stdout
- + testsuite/tests/ghci/prog024/prog024d.script
- + testsuite/tests/ghci/prog024/prog024d.stderr
- + testsuite/tests/ghci/prog024/prog024d.stdout
- + testsuite/tests/ghci/prog024/prog024e.script
- + testsuite/tests/ghci/prog024/prog024e.stdout
- + testsuite/tests/ghci/prog024/prog024f.script
- + testsuite/tests/ghci/prog024/prog024f.stdout
- + testsuite/tests/ghci/prog024/src/A.hs
- + testsuite/tests/ghci/prog024/src/B.hs
- + testsuite/tests/ghci/prog025/Makefile
- + testsuite/tests/ghci/prog025/a/A.hs
- + testsuite/tests/ghci/prog025/all.T
- + testsuite/tests/ghci/prog025/prog025a.script
- + testsuite/tests/ghci/prog025/prog025a.stdout
- + testsuite/tests/ghci/prog025/prog025b.script
- + testsuite/tests/ghci/prog025/prog025b.stdout
- + testsuite/tests/ghci/prog025/testpkg/Test.hs
- + testsuite/tests/ghci/prog025/testpkg/testpkg-0.1.0.0.pkg
- + testsuite/tests/ghci/prog025/testpkg/testpkg-0.2.0.0.pkg
- + testsuite/tests/ghci/prog025/unitA
- testsuite/tests/ghci/scripts/T13997.stdout
- testsuite/tests/ghci/scripts/T1914.stdout
- testsuite/tests/ghci/scripts/T20217.stdout
- testsuite/tests/ghci/scripts/T8042.stdout
- testsuite/tests/ghci/scripts/T8042recomp.stdout
- testsuite/tests/ghci/should_run/T10920.stderr
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/linters/notes.stdout
- testsuite/tests/numeric/should_compile/T15547.stderr
- testsuite/tests/numeric/should_compile/T20347.stderr
- testsuite/tests/numeric/should_compile/T20374.stderr
- testsuite/tests/numeric/should_compile/T20376.stderr
- + testsuite/tests/perf/compiler/T26989.hs
- + testsuite/tests/perf/compiler/T26989a.hs
- testsuite/tests/perf/compiler/all.T
- testsuite/tests/printer/T18052a.stderr
- + testsuite/tests/rts/T25275/DebugIpe.hs
- + testsuite/tests/rts/T25275/T25275_A.stdout
- + testsuite/tests/rts/T25275/T25275_B.stdout
- + testsuite/tests/rts/T25275/T25275_C.stdout
- + testsuite/tests/rts/T25275/T25275_D.stdout
- + testsuite/tests/rts/T25275/TraceIpe.hs
- + testsuite/tests/rts/T25275/all.T
- testsuite/tests/simplCore/should_compile/DsSpecPragmas.stderr
- testsuite/tests/simplCore/should_compile/RewriteHigherOrderPatterns.stderr
- testsuite/tests/simplCore/should_compile/T15205.stderr
- testsuite/tests/simplCore/should_compile/T18668.stderr
- testsuite/tests/simplCore/should_compile/T19246.stderr
- testsuite/tests/simplCore/should_compile/T19599.stderr
- testsuite/tests/simplCore/should_compile/T19599a.stderr
- testsuite/tests/simplCore/should_compile/T21917.stderr
- testsuite/tests/simplCore/should_compile/T23074.stderr
- testsuite/tests/simplCore/should_compile/T24359a.stderr
- testsuite/tests/simplCore/should_compile/T25160.stderr
- testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-32
- testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-64
- testsuite/tests/simplCore/should_compile/T26051.stderr
- testsuite/tests/simplCore/should_compile/T26116.stderr
- testsuite/tests/simplCore/should_compile/T8331.stderr
- testsuite/tests/simplCore/should_compile/T8848a.stderr
- testsuite/tests/simplCore/should_compile/spec004.stderr
- testsuite/tests/typecheck/should_compile/T13032.stderr
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/55c4d1b36d55fcba24479a02f2f01d…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/55c4d1b36d55fcba24479a02f2f01d…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc] Pushed new branch wip/jeltsch/base-buildable-with-ghc-9-14
by Wolfgang Jeltsch (＠jeltsch) 19 May '26
by Wolfgang Jeltsch (＠jeltsch) 19 May '26
19 May '26
Wolfgang Jeltsch pushed new branch wip/jeltsch/base-buildable-with-ghc-9-14 at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/jeltsch/base-buildable-with-g…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Do not use mkCast during typechecking
by Marge Bot (＠marge-bot) 19 May '26
by Marge Bot (＠marge-bot) 19 May '26
19 May '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
ab9a2ef4 by Simon Peyton Jones at 2026-05-18T14:15:05-04:00
Do not use mkCast during typechecking
This commit fixes #27219. The problem was that the typechecker was using
`mkCast`, whose assertion checks legitimately fail when applied to types
that contain unification variables.
- - - - -
6d0fd5d3 by Simon Peyton Jones at 2026-05-18T14:15:05-04:00
Major refactor of the Simplifier
The main payload of this patch is to refactor the Simplifer to avoid
repeated simplification when using Plan (AFTER) for rule rewrites.
The need for this was shown up by #26989.
See Note [Avoid repeated simplification] in GHC.Core.Opt.Simplify.Iteration.
Related refactoring:
* Refactor the two fields `sc_dup` and `sc_env` in `ApplyToVal` into one, `sc_env`.
Reason: the envt is irrelevant in the "simplified" case, so the data type describes
the possiblitiies much more accurately now.
* Some refactoring in `knownCon` to split off `wrapDataConFloats`.
* Refactor `lookupRule` and its auxiliary functions to return `RuleMatch`,
a new data type. See Note [data RuleMatch] in GHC.Core. Ditto for BuiltinRule.
This RuleMatch returns fragments of the target in rm_args and rm_floats,
leaving `rm_rhs` to be the stuff from the RULE itself.
Doing this has routine consequences in GHC.Core.Opt.ConstantFold. Many changes
there but all routine.
* When doing occurrence analysis on RULEs, make the occ-info on the rule
binders relate just to the RHS, not the LHS. See (OUR1) in
Note Note [OccInfo in unfoldings and rules]
This means that Lint must not complain about the fact that the patterns
in the RULE mentions binders that are marked dead.
See Note [Dead occurrences] in GHC.Core.Lint.
I changed the Core pretty-printer so that it didn't suppress dead binders,
else I can't see those binders in RULEs. That led to quite a lot of testsuite wibbles.
* Refactor FloatBinds, so that it is used both by
`exprIsConApp_mabye` and by `lookupRule`
* Move the definition of FloatBinds out of GHc.Core.Make, into GHC.Core.
* Add FloatTick as an extra constructor.
* Refactor `lookupRule` to use `FloatBinds` instead of `BindWrapper`.
This refactor just shares more code.
(Rename GHC.Core.Opt.FloatOut.FloatBinds to FloatLets, to avoid gratuitious
name clash with GHC.Core.FloatBinds.)
Corecion optimisation
* In simpleOpt, when composing coercions, call new function `optTransCo`.
This is much lighter weight than full blown coercion optimisation.
* Make `GHC.Core.Opt.Arity.pushCoValArg` and `pushCoTyArg` return the
coercionLKind of the coercion. This saves recomputing that coercionLKind
at the key call sites in GHC.Core.Opt.Simplify.Iteration.pushCast.
* Rename `addCoerce` in GHC.Core.Simplify.Iteration to become `pushCast`.
* In the `ApplyToVal` case of `pushCast` we had a very unsavoury call to `simplArg`.
I eliminated it by adding a field `sc_cast` to `ApplyToVal` that records any
pending casts. Much nicer now. See Note [The sc_cast field of ApplyToVal].
* Don't optimise coercions if the type-substitution is empty.
See Note [Optimising coercions] in GHC.Core.Opt.Simplify.Iteration.
The fix for #26838 is dramatic. For the test in perf/compiler/T26839 we have
Compiler allocs: Before: 7,363M
After: 688M
Compile time goes down generally. Here are compiler-alloc changes
over 0.5%:
CoOpt_Read(normal) 729,184,920 -0.7%
CoOpt_Singletons(normal) 666,916,960 -4.6% GOOD
LargeRecord(normal) 1,227,056,876 +1.1%
T12227(normal) 256,827,604 -4.6% GOOD
T12425(optasm) 76,879,410 -0.8%
T12545(normal) 787,826,918 -10.8% GOOD
T12707(normal) 775,186,464 -0.9%
T13253(normal) 318,599,596 -0.8%
T14766(normal) 685,857,320 -1.0%
T15304(normal) 1,123,333,422 -2.2%
T15630(normal) 123,142,330 -2.6%
T15630a(normal) 123,092,100 -2.6%
T15703(normal) 299,751,682 -2.9% GOOD
T17516(normal) 964,072,280 +1.0%
T18223(normal) 367,016,820 -6.2% GOOD
T18730(optasm) 130,643,770 -3.3% GOOD
T20261(normal) 535,608,584 -0.7%
T21839c(normal) 340,340,436 -0.9%
T24984(normal) 85,568,392 -1.9%
T3064(normal) 174,631,992 -1.2%
T3294(normal) 1,215,886,432 -0.7%
T5030(normal) 141,449,704 -17.2% GOOD
T5321Fun(normal) 258,484,744 -1.9%
T8095(normal) 770,532,232 -2.7%
T9630(normal) 858,423,408 -14.5% GOOD
T9872c(normal) 1,591,709,448 +0.7%
info_table_map_perf(normal) 19,700,614,458 -1.3%
geo. mean -0.7%
minimum -17.2%
maximum +1.1%
However, strangely there seems to be a 5.0% increase in CoOpt_Read in
the x86_64-linux-fedora43-validate+debug_info+ubsan job, although
there generally a /decrease/ in this test in other builds. The baseline
value looks strange. Anyway I'll just accept it.
Metric Decrease:
CoOpt_Singletons
T12227
T12545
T15703
T18223
T18730
T21839c
T5030
T9630
Metric Increase:
CoOpt_Read
- - - - -
81f4862e by Vladislav Zavialov at 2026-05-18T14:15:06-04:00
Add type families: Tuple, Constraints, Tuple#, Sum# (#27179)
These type families map tuples of types to the corresponding Tuple<N>,
Tuple<N>#, CTuple<N>, and Sum<N># types. Some examples at N=2:
Tuple (Int, Bool) = Tuple2 Int Bool
Constraints (Show a, Eq a) = CTuple2 (Show a) (Eq a)
Tuple# (Int#, Float#) = Tuple2# Int# Float#
Sum# (Int#, Float#) = Sum2# Int# Float#
See GHC Proposal #145 "Non-punning list and tuple syntax".
To make the Sum# instance at N=64 possible, this patch also introduces
the Sum64# constructor declaration and bumps mAX_SUM_SIZE from 63 to 64.
Metric Increase:
ghc_experimental_dir
- - - - -
8c23b3e0 by fendor at 2026-05-18T14:15:07-04:00
Fix regression T27202: `:load` and `:add` work in GHCi
To fix the regression there are conceptually two major things that we
fix:
* We don't remove the `importDirs` from `interactive-session`
* When `:add`ing a module, we don't try to find them via PackageImports
* The PackageImport is wrong as we can't know the package-name at
this stage in ghc/UI.hs
What does it mean to not remove the `importDirs` from
`interactive-session`?
It means that, given some initial `DynFlags`, we will use those
`importDirs` in `interactive-session`.
The initial `DynFlags`, however, depend on how you initialise the GHC
session.
For a simple session, initialised by
ghc -isrc -this-unit-id main
It is simple, just use the `DynFlags` given on the cli.
Thus, `main` and `interactive-session` will have the same `DynFlags`,
except for the `homeUnitId` and `interactive-session` depends on `main`
by construction of the GHCi session.
What about a multiple home unit session, though?
ghc -unit @unit1 -unit @unit2
What are the `DynFlags` in this cli invocation? It shouldn't be either
`@unti1` nor `@unit2`, as the order shouldn't matter or any other
implicit condition.
For consistency, we decide that the initial `DynFlags` are the top
`DynFlags` on the cli, ignoring `-unit` flags.
Thus, in this example, there are no `importsDirs` regardless of what we
might find in `@unit1` and `@unit2`.
But in this invocation:
ghc -isrc -unit @unit1 -unit @unit2
The `interactive-session` will have the `importsDirs` `src`.
Note, `-isrc` will be inherited in `@unit1` and `@unit2`, so you need to
explicitly use `-i` to clear the `importsDirs`, in order to avoid
accidentally adding `src` as an import directory to all other home
units.
This fix has been made possible by the improvements introduced in
!15888, which avoids ambiguity when a home unit shares the `importsDirs`
with the `interactive-session`, on top of being much faster for multiple
home units.
Adds regression tests for T27202 for `:load`ing and `:add`ing modules
that are located in import directories.
- - - - -
17a83421 by fendor at 2026-05-18T14:15:08-04:00
Use home unit package db stacks in GHCi prompt and session unit
In order to import modules from home unit dependencies (e.g., `Data.Map`),
the ghci prompt unit needs to populate its `UnitState`.
This is tricky to handle correctly, which `PackageDBFlag`s should we use
to populate the `UnitState`?
We decide, the most intuitive solution for users is to depend on all
`PackageDBFlag`s, so that any dependency can be imported in GHCi.
This assumes consistency in the `PackageDBFlag`s, so no two home units
specify `PackageDBFlag`s that are inconsistent with each other.
We could simply concat all the `PackageDBFlag`s of the existing home
units, but later `PackageDBFlag`s shadow earlier ones, leading to the
last processed home units' `PackageDBFlag`s to shadow the earlier ones.
This is hard to fix, we need to give users the capability to provide ghc
options for the ghci prompt home unit.
However, as this is considerably more work, we decided on an
approximation that should work out most of the time.
Package Db stacks in cabal and stack follow a certain structure:
-no-user-package-db > -package-db $cabal-store > -package-db $local-db
The first two arguments are always the same, namely the
`-no-user-package-db` and `-package-db`.
We compute the longest common prefix over all home units, and use that
as the start of the package db stack. Then, over the rest of the
`PackageDBFlag`s, we simply take the union and append them to our
initial stack.
We assume, that the rest of package dbs only defines very few, "local"
units that are usually not shadowing each other.
This allows us to get a relatively consistent package database stack for
the ghci prompt home unit.
Similar reasoning applies to the session unit in order to add modules to
the session and have dependencies available in the module.
We do something similar for `-package` flags, to make sure only the
correct units are actually visible in the ghci session.
This time, we simply take the union of all `PackageFlag`s, allowing us
to import modules from the home unit dependencies.
In the future, it would be beneficial to allow the user to provide the
exact ghc options to control the visibilities. For now, this will have
to do.
- - - - -
bb6ac1c9 by Duncan Coutts at 2026-05-18T14:15:08-04:00
Document removal of the signal-based interval timer
Update mentions within the RTS section of the users guide.
Add a changelog entry.
- - - - -
55c4d1b3 by Duncan Coutts at 2026-05-18T14:15:08-04:00
Fix section for an recent changelog entry
- - - - -
149 changed files:
- + changelog.d/T27202
- changelog.d/dynamic-trace-flags
- + changelog.d/lib-add-tuple-tyfam-27179
- + changelog.d/no-more-timer-signal
- compiler/GHC/Core.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Coercion/Opt.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Make.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/Core/Opt/FloatIn.hs
- compiler/GHC/Core/Opt/FloatOut.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Ppr.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Data/List/SetOps.hs
- compiler/GHC/Driver/Config/Core/Lint.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/HsToCore/Pmc/Solver.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Settings/Constants.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Unit/State.hs
- docs/users_guide/profiling.rst
- docs/users_guide/runtime_control.rst
- ghc/GHCi/UI.hs
- ghc/Main.hs
- libraries/base/src/GHC/Base.hs
- libraries/base/src/GHC/Exts.hs
- libraries/ghc-experimental/src/Data/Sum/Experimental.hs
- libraries/ghc-experimental/src/Data/Tuple/Experimental.hs
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Exts.hs
- libraries/ghc-internal/src/GHC/Internal/Types.hs
- testsuite/tests/codeGen/should_compile/T25177.stderr
- testsuite/tests/deSugar/should_compile/T13208.stdout
- testsuite/tests/driver/fat-iface/fat014.stdout
- + testsuite/tests/ghci/prog-mhu006/Makefile
- + testsuite/tests/ghci/prog-mhu006/a/A.hs
- + testsuite/tests/ghci/prog-mhu006/all.T
- + testsuite/tests/ghci/prog-mhu006/b/B.hs
- + testsuite/tests/ghci/prog-mhu006/prog-mhu006a.script
- + testsuite/tests/ghci/prog-mhu006/prog-mhu006a.stdout
- + testsuite/tests/ghci/prog-mhu006/unitA
- + testsuite/tests/ghci/prog-mhu006/unitB
- testsuite/tests/ghci/prog018/prog018.stdout
- testsuite/tests/ghci/prog020/Makefile
- testsuite/tests/ghci/prog020/all.T
- testsuite/tests/ghci/prog020/ghci.prog020.script → testsuite/tests/ghci/prog020/ghci.prog020a.script
- testsuite/tests/ghci/prog020/ghci.prog020.stderr → testsuite/tests/ghci/prog020/ghci.prog020a.stderr
- testsuite/tests/ghci/prog020/ghci.prog020.stdout → testsuite/tests/ghci/prog020/ghci.prog020a.stdout
- + testsuite/tests/ghci/prog020/ghci.prog020b.script
- + testsuite/tests/ghci/prog020/ghci.prog020b.stderr
- + testsuite/tests/ghci/prog020/ghci.prog020b.stdout
- + testsuite/tests/ghci/prog023/Makefile
- + testsuite/tests/ghci/prog023/all.T
- + testsuite/tests/ghci/prog023/prog023a.script
- + testsuite/tests/ghci/prog023/prog023a.stdout
- + testsuite/tests/ghci/prog023/prog023b.script
- + testsuite/tests/ghci/prog023/prog023b.stdout
- + testsuite/tests/ghci/prog023/src/A.hs
- + testsuite/tests/ghci/prog024/Makefile
- + testsuite/tests/ghci/prog024/all.T
- + testsuite/tests/ghci/prog024/prog024a.script
- + testsuite/tests/ghci/prog024/prog024a.stdout
- + testsuite/tests/ghci/prog024/prog024b.script
- + testsuite/tests/ghci/prog024/prog024b.stdout
- + testsuite/tests/ghci/prog024/prog024c.script
- + testsuite/tests/ghci/prog024/prog024c.stderr
- + testsuite/tests/ghci/prog024/prog024c.stdout
- + testsuite/tests/ghci/prog024/prog024d.script
- + testsuite/tests/ghci/prog024/prog024d.stderr
- + testsuite/tests/ghci/prog024/prog024d.stdout
- + testsuite/tests/ghci/prog024/prog024e.script
- + testsuite/tests/ghci/prog024/prog024e.stdout
- + testsuite/tests/ghci/prog024/prog024f.script
- + testsuite/tests/ghci/prog024/prog024f.stdout
- + testsuite/tests/ghci/prog024/src/A.hs
- + testsuite/tests/ghci/prog024/src/B.hs
- + testsuite/tests/ghci/prog025/Makefile
- + testsuite/tests/ghci/prog025/a/A.hs
- + testsuite/tests/ghci/prog025/all.T
- + testsuite/tests/ghci/prog025/prog025a.script
- + testsuite/tests/ghci/prog025/prog025a.stdout
- + testsuite/tests/ghci/prog025/prog025b.script
- + testsuite/tests/ghci/prog025/prog025b.stdout
- + testsuite/tests/ghci/prog025/testpkg/Test.hs
- + testsuite/tests/ghci/prog025/testpkg/testpkg-0.1.0.0.pkg
- + testsuite/tests/ghci/prog025/testpkg/testpkg-0.2.0.0.pkg
- + testsuite/tests/ghci/prog025/unitA
- testsuite/tests/ghci/scripts/ListTuplePunsPprNoAbbrevTuple.stdout
- testsuite/tests/ghci/scripts/T13997.stdout
- testsuite/tests/ghci/scripts/T1914.stdout
- testsuite/tests/ghci/scripts/T20217.stdout
- testsuite/tests/ghci/scripts/T8042.stdout
- testsuite/tests/ghci/scripts/T8042recomp.stdout
- testsuite/tests/ghci/scripts/all.T
- testsuite/tests/ghci/should_run/T10920.stderr
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/interface-stability/ghc-prim-exports.stdout
- testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
- testsuite/tests/linters/notes.stdout
- testsuite/tests/numeric/should_compile/T15547.stderr
- testsuite/tests/numeric/should_compile/T20347.stderr
- testsuite/tests/numeric/should_compile/T20374.stderr
- testsuite/tests/numeric/should_compile/T20376.stderr
- testsuite/tests/parser/should_compile/ListTuplePunsSuccess1.hs
- testsuite/tests/parser/should_compile/all.T
- + testsuite/tests/parser/should_fail/ListTuplePunsFail6.hs
- + testsuite/tests/parser/should_fail/ListTuplePunsFail6.stderr
- testsuite/tests/parser/should_fail/all.T
- testsuite/tests/parser/should_run/ListTuplePunsConstraints.hs
- + testsuite/tests/perf/compiler/T26989.hs
- + testsuite/tests/perf/compiler/T26989a.hs
- testsuite/tests/perf/compiler/all.T
- testsuite/tests/printer/T18052a.stderr
- testsuite/tests/profiling/should_run/callstack001.stdout
- testsuite/tests/simplCore/should_compile/DsSpecPragmas.stderr
- testsuite/tests/simplCore/should_compile/RewriteHigherOrderPatterns.stderr
- testsuite/tests/simplCore/should_compile/T15205.stderr
- testsuite/tests/simplCore/should_compile/T18668.stderr
- testsuite/tests/simplCore/should_compile/T19246.stderr
- testsuite/tests/simplCore/should_compile/T19599.stderr
- testsuite/tests/simplCore/should_compile/T19599a.stderr
- testsuite/tests/simplCore/should_compile/T21917.stderr
- testsuite/tests/simplCore/should_compile/T23074.stderr
- testsuite/tests/simplCore/should_compile/T24359a.stderr
- testsuite/tests/simplCore/should_compile/T25160.stderr
- testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-32
- testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-64
- testsuite/tests/simplCore/should_compile/T26051.stderr
- testsuite/tests/simplCore/should_compile/T26116.stderr
- testsuite/tests/simplCore/should_compile/T8331.stderr
- testsuite/tests/simplCore/should_compile/T8848a.stderr
- testsuite/tests/simplCore/should_compile/spec004.stderr
- testsuite/tests/typecheck/should_compile/T13032.stderr
- + testsuite/tests/typecheck/should_compile/T23135.hs
- testsuite/tests/typecheck/should_compile/all.T
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/296562c80a72152121dc0f4ad28bd9…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/296562c80a72152121dc0f4ad28bd9…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/spj-reinstallable-base2] rebindable imports in base and misc fixes
by Rodrigo Mesquita (＠alt-romes) 19 May '26
by Rodrigo Mesquita (＠alt-romes) 19 May '26
19 May '26
Rodrigo Mesquita pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC
Commits:
6e605d61 by Rodrigo Mesquita at 2026-05-18T17:27:45+01:00
rebindable imports in base and misc fixes
TODO: depends on commits in submodules -- where do I push theM??
- - - - -
41 changed files:
- libraries/base/src/Control/Applicative.hs
- libraries/base/src/Control/Concurrent/Chan.hs
- libraries/base/src/Control/Concurrent/QSem.hs
- libraries/base/src/Control/Concurrent/QSemN.hs
- libraries/base/src/Data/Array/Byte.hs
- libraries/base/src/Data/Bifoldable.hs
- libraries/base/src/Data/Bifoldable1.hs
- libraries/base/src/Data/Bifunctor.hs
- libraries/base/src/Data/Bitraversable.hs
- libraries/base/src/Data/Bool.hs
- libraries/base/src/Data/Complex.hs
- libraries/base/src/Data/Enum.hs
- libraries/base/src/Data/Fixed.hs
- libraries/base/src/Data/Foldable1.hs
- libraries/base/src/Data/Functor/Classes.hs
- libraries/base/src/Data/Functor/Compose.hs
- libraries/base/src/Data/Functor/Contravariant.hs
- libraries/base/src/Data/Functor/Product.hs
- libraries/base/src/Data/Functor/Sum.hs
- libraries/base/src/Data/List.hs
- libraries/base/src/Data/List/NonEmpty.hs
- libraries/base/src/Data/List/NubOrdSet.hs
- libraries/base/src/Data/Semigroup.hs
- libraries/base/src/GHC/Essentials.hs
- libraries/base/src/GHC/Fingerprint.hs
- libraries/base/src/GHC/RTS/Flags.hs
- libraries/base/src/GHC/ResponseFile.hs
- libraries/base/src/GHC/Stats.hs
- libraries/base/src/GHC/Weak/Finalize.hs
- libraries/base/src/System/CPUTime/Posix/ClockGetTime.hsc
- libraries/base/src/System/CPUTime/Posix/RUsage.hsc
- libraries/base/src/System/CPUTime/Unsupported.hs
- libraries/base/src/System/Console/GetOpt.hs
- libraries/base/src/System/Exit.hs
- libraries/base/src/System/IO.hs
- libraries/base/src/System/IO/OS.hs
- libraries/base/src/System/IO/Unsafe.hs
- libraries/base/src/System/Timeout.hs
- libraries/base/src/Text/Printf.hs
- libraries/base/src/Text/Show/Functions.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6e605d61a1a4ec35e8f7db5016ac88a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6e605d61a1a4ec35e8f7db5016ac88a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/davide/ghc-internal-def] WIP Hadrian: fix ghc-internal .def file
by David Eichmann (＠DavidEichmann) 19 May '26
by David Eichmann (＠DavidEichmann) 19 May '26
19 May '26
David Eichmann pushed to branch wip/davide/ghc-internal-def at Glasgow Haskell Compiler / GHC
Commits:
102a282a by David Eichmann at 2026-05-18T17:24:35+01:00
WIP Hadrian: fix ghc-internal .def file
- - - - -
5 changed files:
- hadrian/src/Rules/Generate.hs
- hadrian/src/Rules/Library.hs
- hadrian/src/Rules/Rts.hs
- rts/.gitignore
- rts/win32/libHSghc-internal.def.in
Changes:
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -377,7 +377,6 @@ templateRules = do
, interpolateSetting "ProjectPatchLevel1" ProjectPatchLevel1
, interpolateSetting "ProjectPatchLevel2" ProjectPatchLevel2
]
- templateRule "rts/win32/libHSghc-internal.def" projectVersion
templateRule "docs/index.html" $ packageUnitIds Stage1
templateRule "docs/users_guide/ghc_config.py" $ mconcat
[ projectVersion
=====================================
hadrian/src/Rules/Library.hs
=====================================
@@ -20,6 +20,7 @@ import Utilities
import Data.Time.Clock
import Rules.Generate (generatedDependencies)
import Oracles.Flag
+import Oracles.Setting (setting, Setting (ProjectVersionForLib, ProjectVersion))
-- * Library 'Rules'
@@ -204,7 +205,14 @@ extraObjects context
| package context == rts = do
target <- interpretInContext context getStagedTarget
builddir <- buildPath context
- return [ builddir -/- "libHSghc-internal.dll.a"
+ projectVersionForLib <- setting ProjectVersionForLib
+ projectVersion <- setting ProjectVersion
+ return [ builddir -/-
+ "libHSghc-internal-"
+ <> projectVersionForLib
+ <> ".0-ghc"
+ <> projectVersion
+ <> ".dll.a"
| archOS_OS (tgtArchOs target) == OSMinGW32
, Dynamic `wayUnit` way context ]
=====================================
hadrian/src/Rules/Rts.hs
=====================================
@@ -29,11 +29,19 @@ rtsRules = priority 3 $ do
-- to be linked into the rts dll.
forM_ [Stage1, Stage2, Stage3 ] $ \ stage -> do
let buildPath = root -/- buildDir (rtsContext stage)
- buildPath -/- "libHSghc-internal.dll.a" %> buildGhcInternalImportLib
+ buildPath -/- "libHSghc-internal-*.def" %> buildGhcInternalImportDef
+ buildPath -/- "libHSghc-internal-*.dll.a" %> buildGhcInternalImportLib
+
+buildGhcInternalImportDef :: FilePath -> Action ()
+buildGhcInternalImportDef target = do
+ templateIn <- readFile' "rts/win32/libHSghc-internal.def.in"
+ let dllName = (dropExtension (takeFileName target)) <.> "dll"
+ templateOut = replace "@GhcInternalDll@" dllName templateIn
+ writeFile' target templateOut
buildGhcInternalImportLib :: FilePath -> Action ()
buildGhcInternalImportLib target = do
- let input = "rts/win32/libHSghc-internal.def"
+ let input = (dropExtension (dropExtension target)) <.> "def" -- the .def file
output = target -- the .dll.a import lib
need [input]
runBuilder Dlltool ["-d", input, "-l", output] [input] [output]
=====================================
rts/.gitignore
=====================================
@@ -20,4 +20,3 @@
/ghcautoconf.h.autoconf.in
/ghcautoconf.h.autoconf
/include/ghcautoconf.h
-/win32/libHSghc-internal.def
=====================================
rts/win32/libHSghc-internal.def.in
=====================================
@@ -1,4 +1,4 @@
-LIBRARY libHSghc-internal-@ProjectVersionForLib@.0-ghc@ProjectVersion@.dll
+LIBRARY @GhcInternalDll@
EXPORTS
init_ghc_hs_iface
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/102a282ad14339930640c79eec017ab…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/102a282ad14339930640c79eec017ab…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc] Pushed new branch wip/davide/ghc-internal-def
by David Eichmann (＠DavidEichmann) 19 May '26
by David Eichmann (＠DavidEichmann) 19 May '26
19 May '26
David Eichmann pushed new branch wip/davide/ghc-internal-def at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/davide/ghc-internal-def
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/spj-reinstallable-base2] 2 commits: kill all TH known keys, keep the occs
by Rodrigo Mesquita (＠alt-romes) 18 May '26
by Rodrigo Mesquita (＠alt-romes) 18 May '26
18 May '26
Rodrigo Mesquita pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC
Commits:
c807aec4 by Rodrigo Mesquita at 2026-05-18T12:07:35+01:00
kill all TH known keys, keep the occs
- - - - -
0749548e by Rodrigo Mesquita at 2026-05-18T16:10:47+01:00
fix th things
- - - - -
5 changed files:
- compiler/GHC/Builtin/TH.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Tc/Gen/Splice.hs
- libraries/base/src/GHC/Essentials.hs
Changes:
=====================================
compiler/GHC/Builtin/TH.hs
=====================================
@@ -8,10 +8,8 @@ module GHC.Builtin.TH where
import GHC.Prelude ()
-import GHC.Types.Name( Name, KnownOcc )
+import GHC.Types.Name( KnownOcc )
import GHC.Types.Name.Occurrence
-import GHC.Types.Unique ( Unique )
-import GHC.Builtin.Uniques
import GHC.Data.FastString
-------------------- TH.Syntax -----------------------
@@ -230,8 +228,7 @@ implicitParamBindDOcc = mkVarOcc "implicitParamBindD"
-- type Ctxt = ...
cxtName :: KnownOcc
-cxtName = mkVarOcc "cxt" -- TODO: WHERE IS THIS; AND DO I NEED TO EXPORT IT FROM GHC.Essentials??
- -- Look at the knownOccs below up until BangTypeName too.
+cxtName = mkVarOcc "cxt"
-- data SourceUnpackedness = ...
noSourceUnpackednessOcc, sourceNoUnpackOcc, sourceUnpackOcc :: KnownOcc
@@ -260,23 +257,23 @@ bangName = mkVarOcc "bang"
-- type BangType = ...
bangTypeName :: KnownOcc
-bangTypeName = libFun (fsLit "bangType") bangTKey
+bangTypeName = mkVarOcc "bangType"
-- type VarBangType = ...
varBangTypeName :: KnownOcc
-varBangTypeName = libFun (fsLit "varBangType") varBangTKey
+varBangTypeName = mkVarOcc "varBangType"
-- data PatSynDir = ...
unidirPatSynName, implBidirPatSynName, explBidirPatSynName :: KnownOcc
-unidirPatSynName = libFun (fsLit "unidir") unidirPatSynIdKey
-implBidirPatSynName = libFun (fsLit "implBidir") implBidirPatSynIdKey
-explBidirPatSynName = libFun (fsLit "explBidir") explBidirPatSynIdKey
+unidirPatSynName = mkVarOcc "unidir"
+implBidirPatSynName = mkVarOcc "implBidir"
+explBidirPatSynName = mkVarOcc "explBidir"
-- data PatSynArgs = ...
prefixPatSynName, infixPatSynName, recordPatSynName :: KnownOcc
-prefixPatSynName = libFun (fsLit "prefixPatSyn") prefixPatSynIdKey
-infixPatSynName = libFun (fsLit "infixPatSyn") infixPatSynIdKey
-recordPatSynName = libFun (fsLit "recordPatSyn") recordPatSynIdKey
+prefixPatSynName = mkVarOcc "prefixPatSyn"
+infixPatSynName = mkVarOcc "infixPatSyn"
+recordPatSynName = mkVarOcc "recordPatSyn"
-- data Type = ...
forallTName, forallVisTName, varTName, conTName, infixTName, tupleTName,
@@ -284,124 +281,124 @@ forallTName, forallVisTName, varTName, conTName, infixTName, tupleTName,
appTName, appKindTName, sigTName, equalityTName, litTName, promotedTName,
promotedTupleTName, promotedNilTName, promotedConsTName,
wildCardTName, implicitParamTName :: KnownOcc
-forallTName = libFun (fsLit "forallT") forallTIdKey
-forallVisTName = libFun (fsLit "forallVisT") forallVisTIdKey
-varTName = libFun (fsLit "varT") varTIdKey
-conTName = libFun (fsLit "conT") conTIdKey
-tupleTName = libFun (fsLit "tupleT") tupleTIdKey
-unboxedTupleTName = libFun (fsLit "unboxedTupleT") unboxedTupleTIdKey
-unboxedSumTName = libFun (fsLit "unboxedSumT") unboxedSumTIdKey
-arrowTName = libFun (fsLit "arrowT") arrowTIdKey
-mulArrowTName = libFun (fsLit "mulArrowT") mulArrowTIdKey
-listTName = libFun (fsLit "listT") listTIdKey
-appTName = libFun (fsLit "appT") appTIdKey
-appKindTName = libFun (fsLit "appKindT") appKindTIdKey
-sigTName = libFun (fsLit "sigT") sigTIdKey
-equalityTName = libFun (fsLit "equalityT") equalityTIdKey
-litTName = libFun (fsLit "litT") litTIdKey
-promotedTName = libFun (fsLit "promotedT") promotedTIdKey
-promotedTupleTName = libFun (fsLit "promotedTupleT") promotedTupleTIdKey
-promotedNilTName = libFun (fsLit "promotedNilT") promotedNilTIdKey
-promotedConsTName = libFun (fsLit "promotedConsT") promotedConsTIdKey
-wildCardTName = libFun (fsLit "wildCardT") wildCardTIdKey
-infixTName = libFun (fsLit "infixT") infixTIdKey
-implicitParamTName = libFun (fsLit "implicitParamT") implicitParamTIdKey
+forallTName = mkVarOcc "forallT"
+forallVisTName = mkVarOcc "forallVisT"
+varTName = mkVarOcc "varT"
+conTName = mkVarOcc "conT"
+tupleTName = mkVarOcc "tupleT"
+unboxedTupleTName = mkVarOcc "unboxedTupleT"
+unboxedSumTName = mkVarOcc "unboxedSumT"
+arrowTName = mkVarOcc "arrowT"
+mulArrowTName = mkVarOcc "mulArrowT"
+listTName = mkVarOcc "listT"
+appTName = mkVarOcc "appT"
+appKindTName = mkVarOcc "appKindT"
+sigTName = mkVarOcc "sigT"
+equalityTName = mkVarOcc "equalityT"
+litTName = mkVarOcc "litT"
+promotedTName = mkVarOcc "promotedT"
+promotedTupleTName = mkVarOcc "promotedTupleT"
+promotedNilTName = mkVarOcc "promotedNilT"
+promotedConsTName = mkVarOcc "promotedConsT"
+wildCardTName = mkVarOcc "wildCardT"
+infixTName = mkVarOcc "infixT"
+implicitParamTName = mkVarOcc "implicitParamT"
-- data TyLit = ...
numTyLitName, strTyLitName, charTyLitName :: KnownOcc
-numTyLitName = libFun (fsLit "numTyLit") numTyLitIdKey
-strTyLitName = libFun (fsLit "strTyLit") strTyLitIdKey
-charTyLitName = libFun (fsLit "charTyLit") charTyLitIdKey
+numTyLitName = mkVarOcc "numTyLit"
+strTyLitName = mkVarOcc "strTyLit"
+charTyLitName = mkVarOcc "charTyLit"
-- data TyVarBndr = ...
plainTVName, kindedTVName :: KnownOcc
-plainTVName = libFun (fsLit "plainTV") plainTVIdKey
-kindedTVName = libFun (fsLit "kindedTV") kindedTVIdKey
+plainTVName = mkVarOcc "plainTV"
+kindedTVName = mkVarOcc "kindedTV"
plainInvisTVName, kindedInvisTVName :: KnownOcc
-plainInvisTVName = libFun (fsLit "plainInvisTV") plainInvisTVIdKey
-kindedInvisTVName = libFun (fsLit "kindedInvisTV") kindedInvisTVIdKey
+plainInvisTVName = mkVarOcc "plainInvisTV"
+kindedInvisTVName = mkVarOcc "kindedInvisTV"
plainBndrTVName, kindedBndrTVName :: KnownOcc
-plainBndrTVName = libFun (fsLit "plainBndrTV") plainBndrTVIdKey
-kindedBndrTVName = libFun (fsLit "kindedBndrTV") kindedBndrTVIdKey
+plainBndrTVName = mkVarOcc "plainBndrTV"
+kindedBndrTVName = mkVarOcc "kindedBndrTV"
-- data Specificity = ...
specifiedSpecName, inferredSpecName :: KnownOcc
-specifiedSpecName = libFun (fsLit "specifiedSpec") specifiedSpecKey
-inferredSpecName = libFun (fsLit "inferredSpec") inferredSpecKey
+specifiedSpecName = mkVarOcc "specifiedSpec"
+inferredSpecName = mkVarOcc "inferredSpec"
-- data BndrVis = ...
bndrReqName, bndrInvisName :: KnownOcc
-bndrReqName = libFun (fsLit "bndrReq") bndrReqKey
-bndrInvisName = libFun (fsLit "bndrInvis") bndrInvisKey
+bndrReqName = mkVarOcc "bndrReq"
+bndrInvisName = mkVarOcc "bndrInvis"
-- data Role = ...
nominalRName, representationalRName, phantomRName, inferRName :: KnownOcc
-nominalRName = libFun (fsLit "nominalR") nominalRIdKey
-representationalRName = libFun (fsLit "representationalR") representationalRIdKey
-phantomRName = libFun (fsLit "phantomR") phantomRIdKey
-inferRName = libFun (fsLit "inferR") inferRIdKey
+nominalRName = mkVarOcc "nominalR"
+representationalRName = mkVarOcc "representationalR"
+phantomRName = mkVarOcc "phantomR"
+inferRName = mkVarOcc "inferR"
-- data Kind = ...
starKName, constraintKName :: KnownOcc
-starKName = libFun (fsLit "starK") starKIdKey
-constraintKName = libFun (fsLit "constraintK") constraintKIdKey
+starKName = mkVarOcc "starK"
+constraintKName = mkVarOcc "constraintK"
-- data FamilyResultSig = ...
noSigName, kindSigName, tyVarSigName :: KnownOcc
-noSigName = libFun (fsLit "noSig") noSigIdKey
-kindSigName = libFun (fsLit "kindSig") kindSigIdKey
-tyVarSigName = libFun (fsLit "tyVarSig") tyVarSigIdKey
+noSigName = mkVarOcc "noSig"
+kindSigName = mkVarOcc "kindSig"
+tyVarSigName = mkVarOcc "tyVarSig"
-- data InjectivityAnn = ...
injectivityAnnName :: KnownOcc
-injectivityAnnName = libFun (fsLit "injectivityAnn") injectivityAnnIdKey
+injectivityAnnName = mkVarOcc "injectivityAnn"
-- data Callconv = ...
cCallName, stdCallName, cApiCallName, primCallName, javaScriptCallName :: KnownOcc
-cCallName = libFun (fsLit "cCall") cCallIdKey
-stdCallName = libFun (fsLit "stdCall") stdCallIdKey
-cApiCallName = libFun (fsLit "cApi") cApiCallIdKey
-primCallName = libFun (fsLit "prim") primCallIdKey
-javaScriptCallName = libFun (fsLit "javaScript") javaScriptCallIdKey
+cCallName = mkVarOcc "cCall"
+stdCallName = mkVarOcc "stdCall"
+cApiCallName = mkVarOcc "cApi"
+primCallName = mkVarOcc "prim"
+javaScriptCallName = mkVarOcc "javaScript"
-- data Safety = ...
unsafeName, safeName, interruptibleName :: KnownOcc
-unsafeName = libFun (fsLit "unsafe") unsafeIdKey
-safeName = libFun (fsLit "safe") safeIdKey
-interruptibleName = libFun (fsLit "interruptible") interruptibleIdKey
+unsafeName = mkVarOcc "unsafe"
+safeName = mkVarOcc "safe"
+interruptibleName = mkVarOcc "interruptible"
-- data RuleBndr = ...
ruleVarName, typedRuleVarName :: KnownOcc
-ruleVarName = libFun (fsLit ("ruleVar")) ruleVarIdKey
-typedRuleVarName = libFun (fsLit ("typedRuleVar")) typedRuleVarIdKey
+ruleVarName = mkVarOcc "ruleVar"
+typedRuleVarName = mkVarOcc "typedRuleVar"
-- data FunDep = ...
funDepName :: KnownOcc
-funDepName = libFun (fsLit "funDep") funDepIdKey
+funDepName = mkVarOcc "funDep"
-- data TySynEqn = ...
tySynEqnName :: KnownOcc
-tySynEqnName = libFun (fsLit "tySynEqn") tySynEqnIdKey
+tySynEqnName = mkVarOcc "tySynEqn"
-- data AnnTarget = ...
valueAnnotationName, typeAnnotationName, moduleAnnotationName :: KnownOcc
-valueAnnotationName = libFun (fsLit "valueAnnotation") valueAnnotationIdKey
-typeAnnotationName = libFun (fsLit "typeAnnotation") typeAnnotationIdKey
-moduleAnnotationName = libFun (fsLit "moduleAnnotation") moduleAnnotationIdKey
+valueAnnotationName = mkVarOcc "valueAnnotation"
+typeAnnotationName = mkVarOcc "typeAnnotation"
+moduleAnnotationName = mkVarOcc "moduleAnnotation"
-- type DerivClause = ...
derivClauseName :: KnownOcc
-derivClauseName = libFun (fsLit "derivClause") derivClauseIdKey
+derivClauseName = mkVarOcc "derivClause"
-- data DerivStrategy = ...
stockStrategyName, anyclassStrategyName, newtypeStrategyName,
viaStrategyName :: KnownOcc
-stockStrategyName = libFun (fsLit "stockStrategy") stockStrategyIdKey
-anyclassStrategyName = libFun (fsLit "anyclassStrategy") anyclassStrategyIdKey
-newtypeStrategyName = libFun (fsLit "newtypeStrategy") newtypeStrategyIdKey
-viaStrategyName = libFun (fsLit "viaStrategy") viaStrategyIdKey
+stockStrategyName = mkVarOcc "stockStrategy"
+anyclassStrategyName = mkVarOcc "anyclassStrategy"
+newtypeStrategyName = mkVarOcc "newtypeStrategy"
+viaStrategyName = mkVarOcc "viaStrategy"
patQTyConOcc, expQTyConOcc, stmtTyConOcc,
conTyConOcc, bangTypeTyConOcc,
@@ -433,276 +430,42 @@ derivStrategyTyConOcc = mkTcOcc "DerivStrategy"
-- quasiquoting
quoteExpName, quotePatName, quoteDecName, quoteTypeName :: KnownOcc
-quoteExpName = qqFld (fsLit "quoteExp") quoteExpKey
-quotePatName = qqFld (fsLit "quotePat") quotePatKey
-quoteDecName = qqFld (fsLit "quoteDec") quoteDecKey
-quoteTypeName = qqFld (fsLit "quoteType") quoteTypeKey
+quoteExpName = mkRecFieldOcc (fsLit "QuasiQuoter") "quoteExp"
+quotePatName = mkRecFieldOcc (fsLit "QuasiQuoter") "quotePat"
+quoteDecName = mkRecFieldOcc (fsLit "QuasiQuoter") "quoteDec"
+quoteTypeName = mkRecFieldOcc (fsLit "QuasiQuoter") "quoteType"
-- data Inline = ...
noInlineDataConName, inlineDataConName, inlinableDataConName :: KnownOcc
-noInlineDataConName = thCon (fsLit "NoInline") noInlineDataConKey
-inlineDataConName = thCon (fsLit "Inline") inlineDataConKey
-inlinableDataConName = thCon (fsLit "Inlinable") inlinableDataConKey
+noInlineDataConName = mkDataOcc "NoInline"
+inlineDataConName = mkDataOcc "Inline"
+inlinableDataConName = mkDataOcc "Inlinable"
-- data RuleMatch = ...
conLikeDataConName, funLikeDataConName :: KnownOcc
-conLikeDataConName = thCon (fsLit "ConLike") conLikeDataConKey
-funLikeDataConName = thCon (fsLit "FunLike") funLikeDataConKey
+conLikeDataConName = mkDataOcc "ConLike"
+funLikeDataConName = mkDataOcc "FunLike"
-- data Phases = ...
allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName :: KnownOcc
-allPhasesDataConName = thCon (fsLit "AllPhases") allPhasesDataConKey
-fromPhaseDataConName = thCon (fsLit "FromPhase") fromPhaseDataConKey
-beforePhaseDataConName = thCon (fsLit "BeforePhase") beforePhaseDataConKey
+allPhasesDataConName = mkDataOcc "AllPhases"
+fromPhaseDataConName = mkDataOcc "FromPhase"
+beforePhaseDataConName = mkDataOcc "BeforePhase"
-- data Overlap = ...
overlappableDataConName,
overlappingDataConName,
overlapsDataConName,
incoherentDataConName :: KnownOcc
-overlappableDataConName = thCon (fsLit "Overlappable") overlappableDataConKey
-overlappingDataConName = thCon (fsLit "Overlapping") overlappingDataConKey
-overlapsDataConName = thCon (fsLit "Overlaps") overlapsDataConKey
-incoherentDataConName = thCon (fsLit "Incoherent") incoherentDataConKey
+overlappableDataConName = mkDataOcc "Overlappable"
+overlappingDataConName = mkDataOcc "Overlapping"
+overlapsDataConName = mkDataOcc "Overlaps"
+incoherentDataConName = mkDataOcc "Incoherent"
-- data NamespaceSpecifier = ...
noNamespaceSpecifierDataConName,
typeNamespaceSpecifierDataConName,
dataNamespaceSpecifierDataConName :: KnownOcc
-noNamespaceSpecifierDataConName =
- thCon (fsLit "NoNamespaceSpecifier") noNamespaceSpecifierDataConKey
-typeNamespaceSpecifierDataConName =
- thCon (fsLit "TypeNamespaceSpecifier") typeNamespaceSpecifierDataConKey
-dataNamespaceSpecifierDataConName =
- thCon (fsLit "DataNamespaceSpecifier") dataNamespaceSpecifierDataConKey
-
-{- *********************************************************************
-* *
- Class keys
-* *
-********************************************************************* -}
-
--- ClassUniques available: 200-299
--- Check in GHC.Builtin.KnownKeys if you want to change this
-
-liftClassKey :: Unique
-liftClassKey = mkPreludeClassUnique 200
-
-{- *********************************************************************
-* *
- TyCon keys
-* *
-********************************************************************* -}
-
--- TyConUniques available: 200-299
--- Check in GHC.Builtin.KnownKeys if you want to change this
-
-
-{- *********************************************************************
-* *
- DataCon keys
-* *
-********************************************************************* -}
-
--- DataConUniques available: 100-150
--- If you want to change this, make sure you check in GHC.Builtin.KnownKeys
-
--- data Inline = ...
-noInlineDataConKey, inlineDataConKey, inlinableDataConKey :: Unique
-noInlineDataConKey = mkPreludeDataConUnique 200
-inlineDataConKey = mkPreludeDataConUnique 201
-inlinableDataConKey = mkPreludeDataConUnique 202
-
--- data RuleMatch = ...
-conLikeDataConKey, funLikeDataConKey :: Unique
-conLikeDataConKey = mkPreludeDataConUnique 204
-funLikeDataConKey = mkPreludeDataConUnique 205
-
--- data Phases = ...
-allPhasesDataConKey, fromPhaseDataConKey, beforePhaseDataConKey :: Unique
-allPhasesDataConKey = mkPreludeDataConUnique 206
-fromPhaseDataConKey = mkPreludeDataConUnique 207
-beforePhaseDataConKey = mkPreludeDataConUnique 208
-
--- data Overlap = ..
-overlappableDataConKey,
- overlappingDataConKey,
- overlapsDataConKey,
- incoherentDataConKey :: Unique
-overlappableDataConKey = mkPreludeDataConUnique 209
-overlappingDataConKey = mkPreludeDataConUnique 210
-overlapsDataConKey = mkPreludeDataConUnique 211
-incoherentDataConKey = mkPreludeDataConUnique 212
-
--- data NamespaceSpecifier = ...
-noNamespaceSpecifierDataConKey,
- typeNamespaceSpecifierDataConKey,
- dataNamespaceSpecifierDataConKey :: Unique
-noNamespaceSpecifierDataConKey = mkPreludeDataConUnique 213
-typeNamespaceSpecifierDataConKey = mkPreludeDataConUnique 214
-dataNamespaceSpecifierDataConKey = mkPreludeDataConUnique 215
-{- *********************************************************************
-* *
- Id keys
-* *
-********************************************************************* -}
-
--- IdUniques available: 200-499
--- If you want to change this, make sure you check in GHC.Builtin.KnownKeys
-
--- type BangType = ...
-bangTKey :: Unique
-bangTKey = mkPreludeMiscIdUnique 375
-
--- type VarBangType = ...
-varBangTKey :: Unique
-varBangTKey = mkPreludeMiscIdUnique 376
-
--- data PatSynDir = ...
-unidirPatSynIdKey, implBidirPatSynIdKey, explBidirPatSynIdKey :: Unique
-unidirPatSynIdKey = mkPreludeMiscIdUnique 377
-implBidirPatSynIdKey = mkPreludeMiscIdUnique 378
-explBidirPatSynIdKey = mkPreludeMiscIdUnique 379
-
--- data PatSynArgs = ...
-prefixPatSynIdKey, infixPatSynIdKey, recordPatSynIdKey :: Unique
-prefixPatSynIdKey = mkPreludeMiscIdUnique 380
-infixPatSynIdKey = mkPreludeMiscIdUnique 381
-recordPatSynIdKey = mkPreludeMiscIdUnique 382
-
--- data Type = ...
-forallTIdKey, forallVisTIdKey, varTIdKey, conTIdKey, tupleTIdKey,
- unboxedTupleTIdKey, unboxedSumTIdKey, arrowTIdKey, listTIdKey, appTIdKey,
- appKindTIdKey, sigTIdKey, equalityTIdKey, litTIdKey, promotedTIdKey,
- promotedTupleTIdKey, promotedNilTIdKey, promotedConsTIdKey,
- wildCardTIdKey, implicitParamTIdKey, infixTIdKey :: Unique
-forallTIdKey = mkPreludeMiscIdUnique 390
-forallVisTIdKey = mkPreludeMiscIdUnique 391
-varTIdKey = mkPreludeMiscIdUnique 392
-conTIdKey = mkPreludeMiscIdUnique 393
-tupleTIdKey = mkPreludeMiscIdUnique 394
-unboxedTupleTIdKey = mkPreludeMiscIdUnique 395
-unboxedSumTIdKey = mkPreludeMiscIdUnique 396
-arrowTIdKey = mkPreludeMiscIdUnique 397
-listTIdKey = mkPreludeMiscIdUnique 398
-appTIdKey = mkPreludeMiscIdUnique 399
-appKindTIdKey = mkPreludeMiscIdUnique 400
-sigTIdKey = mkPreludeMiscIdUnique 401
-equalityTIdKey = mkPreludeMiscIdUnique 402
-litTIdKey = mkPreludeMiscIdUnique 403
-promotedTIdKey = mkPreludeMiscIdUnique 404
-promotedTupleTIdKey = mkPreludeMiscIdUnique 405
-promotedNilTIdKey = mkPreludeMiscIdUnique 406
-promotedConsTIdKey = mkPreludeMiscIdUnique 407
-wildCardTIdKey = mkPreludeMiscIdUnique 408
-implicitParamTIdKey = mkPreludeMiscIdUnique 409
-infixTIdKey = mkPreludeMiscIdUnique 410
-
--- data TyLit = ...
-numTyLitIdKey, strTyLitIdKey, charTyLitIdKey :: Unique
-numTyLitIdKey = mkPreludeMiscIdUnique 411
-strTyLitIdKey = mkPreludeMiscIdUnique 412
-charTyLitIdKey = mkPreludeMiscIdUnique 413
-
--- data TyVarBndr = ...
-plainTVIdKey, kindedTVIdKey :: Unique
-plainTVIdKey = mkPreludeMiscIdUnique 414
-kindedTVIdKey = mkPreludeMiscIdUnique 415
-
-plainInvisTVIdKey, kindedInvisTVIdKey :: Unique
-plainInvisTVIdKey = mkPreludeMiscIdUnique 482
-kindedInvisTVIdKey = mkPreludeMiscIdUnique 483
-
-plainBndrTVIdKey, kindedBndrTVIdKey :: Unique
-plainBndrTVIdKey = mkPreludeMiscIdUnique 484
-kindedBndrTVIdKey = mkPreludeMiscIdUnique 485
-
--- data Role = ...
-nominalRIdKey, representationalRIdKey, phantomRIdKey, inferRIdKey :: Unique
-nominalRIdKey = mkPreludeMiscIdUnique 416
-representationalRIdKey = mkPreludeMiscIdUnique 417
-phantomRIdKey = mkPreludeMiscIdUnique 418
-inferRIdKey = mkPreludeMiscIdUnique 419
-
--- data Kind = ...
-starKIdKey, constraintKIdKey :: Unique
-starKIdKey = mkPreludeMiscIdUnique 425
-constraintKIdKey = mkPreludeMiscIdUnique 426
-
--- data FamilyResultSig = ...
-noSigIdKey, kindSigIdKey, tyVarSigIdKey :: Unique
-noSigIdKey = mkPreludeMiscIdUnique 427
-kindSigIdKey = mkPreludeMiscIdUnique 428
-tyVarSigIdKey = mkPreludeMiscIdUnique 429
-
--- data InjectivityAnn = ...
-injectivityAnnIdKey :: Unique
-injectivityAnnIdKey = mkPreludeMiscIdUnique 430
-
--- data Callconv = ...
-cCallIdKey, stdCallIdKey, cApiCallIdKey, primCallIdKey,
- javaScriptCallIdKey :: Unique
-cCallIdKey = mkPreludeMiscIdUnique 431
-stdCallIdKey = mkPreludeMiscIdUnique 432
-cApiCallIdKey = mkPreludeMiscIdUnique 433
-primCallIdKey = mkPreludeMiscIdUnique 434
-javaScriptCallIdKey = mkPreludeMiscIdUnique 435
-
--- data Safety = ...
-unsafeIdKey, safeIdKey, interruptibleIdKey :: Unique
-unsafeIdKey = mkPreludeMiscIdUnique 440
-safeIdKey = mkPreludeMiscIdUnique 441
-interruptibleIdKey = mkPreludeMiscIdUnique 442
-
--- data FunDep = ...
-funDepIdKey :: Unique
-funDepIdKey = mkPreludeMiscIdUnique 445
-
--- mulArrow
-mulArrowTIdKey :: Unique
-mulArrowTIdKey = mkPreludeMiscIdUnique 446
-
--- data TySynEqn = ...
-tySynEqnIdKey :: Unique
-tySynEqnIdKey = mkPreludeMiscIdUnique 460
-
--- quasiquoting
-quoteExpKey, quotePatKey, quoteDecKey, quoteTypeKey :: Unique
-quoteExpKey = mkPreludeMiscIdUnique 470
-quotePatKey = mkPreludeMiscIdUnique 471
-quoteDecKey = mkPreludeMiscIdUnique 472
-quoteTypeKey = mkPreludeMiscIdUnique 473
-
--- data RuleBndr = ...
-ruleVarIdKey, typedRuleVarIdKey :: Unique
-ruleVarIdKey = mkPreludeMiscIdUnique 480
-typedRuleVarIdKey = mkPreludeMiscIdUnique 481
-
--- data AnnTarget = ...
-valueAnnotationIdKey, typeAnnotationIdKey, moduleAnnotationIdKey :: Unique
-valueAnnotationIdKey = mkPreludeMiscIdUnique 490
-typeAnnotationIdKey = mkPreludeMiscIdUnique 491
-moduleAnnotationIdKey = mkPreludeMiscIdUnique 492
-
--- type DerivPred = ...
-derivClauseIdKey :: Unique
-derivClauseIdKey = mkPreludeMiscIdUnique 493
-
--- data DerivStrategy = ...
-stockStrategyIdKey, anyclassStrategyIdKey, newtypeStrategyIdKey,
- viaStrategyIdKey :: Unique
-stockStrategyIdKey = mkPreludeDataConUnique 494
-anyclassStrategyIdKey = mkPreludeDataConUnique 495
-newtypeStrategyIdKey = mkPreludeDataConUnique 496
-viaStrategyIdKey = mkPreludeDataConUnique 497
-
--- data Specificity = ...
-specifiedSpecKey, inferredSpecKey :: Unique
-specifiedSpecKey = mkPreludeMiscIdUnique 498
-inferredSpecKey = mkPreludeMiscIdUnique 499
-
--- data BndrVis = ...
-bndrReqKey, bndrInvisKey :: Unique
-bndrReqKey = mkPreludeMiscIdUnique 800 -- TODO (int-index): make up some room in the 5** numberspace?
-bndrInvisKey = mkPreludeMiscIdUnique 801
-
+noNamespaceSpecifierDataConName = mkDataOcc "NoNamespaceSpecifier"
+typeNamespaceSpecifierDataConName = mkDataOcc "TypeNamespaceSpecifier"
+dataNamespaceSpecifierDataConName = mkDataOcc "DataNamespaceSpecifier"
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -887,7 +887,7 @@ repC (L _ (ConDeclH98 { con_name = con
; ctxt' <- repMbContext mcxt
; if not is_existential && isNothing mcxt
then return c'
- else rep2 forallCName ([unC ex_bndrs, unC ctxt', unC c'])
+ else rep2 forallCOcc ([unC ex_bndrs, unC ctxt', unC c'])
}
repC (L l (ConDeclGADT { con_names = cons
@@ -908,12 +908,12 @@ repC (L l (ConDeclGADT { con_names = cons
let loop last_bndrs' [] = do
ctxt' <- repMbContext mcxt
c' <- repGadtDataCons cons args res_ty
- rep2 forallCName ([unC last_bndrs', unC ctxt', unC c'])
+ rep2 forallCOcc ([unC last_bndrs', unC ctxt', unC c'])
loop last_bndrs' (bndrs : bndrs_s) =
addHsTyVarBinds FreshNamesOnly bndrs $ \bndrs' -> do
body_c' <- loop bndrs' bndrs_s
ctxt' <- repContext []
- rep2 forallCName [unC last_bndrs', unC ctxt', unC body_c']
+ rep2 forallCOcc [unC last_bndrs', unC ctxt', unC body_c']
in loop outer_bndrs' invis_inner_bndrs
| Nothing <- m_invis_inner_bndrs
@@ -935,14 +935,14 @@ repMbContext Nothing = repContext []
repMbContext (Just (L _ cxt)) = repContext cxt
repSrcUnpackedness :: SrcUnpackedness -> MetaM (Core (M TH.SourceUnpackedness))
-repSrcUnpackedness SrcUnpack = rep2 sourceUnpackName []
-repSrcUnpackedness SrcNoUnpack = rep2 sourceNoUnpackName []
-repSrcUnpackedness NoSrcUnpack = rep2 noSourceUnpackednessName []
+repSrcUnpackedness SrcUnpack = rep2 sourceUnpackOcc []
+repSrcUnpackedness SrcNoUnpack = rep2 sourceNoUnpackOcc []
+repSrcUnpackedness NoSrcUnpack = rep2 noSourceUnpackednessOcc []
repSrcStrictness :: SrcStrictness -> MetaM (Core (M TH.SourceStrictness))
-repSrcStrictness SrcLazy = rep2 sourceLazyName []
-repSrcStrictness SrcStrict = rep2 sourceStrictName []
-repSrcStrictness NoSrcStrict = rep2 noSourceStrictnessName []
+repSrcStrictness SrcLazy = rep2 sourceLazyOcc []
+repSrcStrictness SrcStrict = rep2 sourceStrictOcc []
+repSrcStrictness NoSrcStrict = rep2 noSourceStrictnessOcc []
repConDeclField :: HsConDeclField GhcRn -> MetaM (Core (M TH.BangType))
repConDeclField (CDF { cdf_unpack, cdf_bang, cdf_type }) = do
@@ -2344,7 +2344,7 @@ globalVarLocal unique name
= do { MkC occ <- occNameLit name
; platform <- targetPlatform <$> getDynFlags
; let uni = mkIntegerExpr platform (toInteger $ getKey unique)
- ; rep2_nwDsM mkNameLName [occ,uni] }
+ ; rep2_nwDsM mkNameLOcc [occ,uni] }
globalVarExternal :: Module -> OccName -> DsM (Core TH.Name)
globalVarExternal mod name_occ
@@ -2352,14 +2352,14 @@ globalVarExternal mod name_occ
; MkC pkg <- coreStringLit name_pkg
; MkC occ <- occNameLit name_occ
; if | isDataOcc name_occ
- -> rep2_nwDsM mkNameG_dName [pkg,mod,occ]
+ -> rep2_nwDsM mkNameG_dOcc [pkg,mod,occ]
| isVarOcc name_occ
- -> rep2_nwDsM mkNameG_vName [pkg,mod,occ]
+ -> rep2_nwDsM mkNameG_vOcc [pkg,mod,occ]
| isTcOcc name_occ
- -> rep2_nwDsM mkNameG_tcName [pkg,mod,occ]
+ -> rep2_nwDsM mkNameG_tcOcc [pkg,mod,occ]
| Just con_fs <- fieldOcc_maybe name_occ
-> do { MkC con <- coreStringLit con_fs
- ; rep2_nwDsM mkNameG_fldName [pkg,mod,con,occ] }
+ ; rep2_nwDsM mkNameG_fldOcc [pkg,mod,con,occ] }
| otherwise
-> pprPanic "GHC.HsToCore.Quote.globalVar" (ppr name_occ)
}
@@ -2465,11 +2465,11 @@ krep2X lift_dsm get_wrap n xs = do
-dataCon' :: Name -> [CoreExpr] -> MetaM (Core a)
-dataCon' n args = do { id <- lift $ dsLookupDataCon n
+dataCon' :: KnownOcc -> [CoreExpr] -> MetaM (Core a)
+dataCon' n args = do { id <- lift $ dsLookupKnownOccDataCon n
; return $ MkC $ mkCoreConApps id args }
-dataCon :: Name -> MetaM (Core a)
+dataCon :: KnownOcc -> MetaM (Core a)
dataCon n = dataCon' n []
@@ -2615,7 +2615,7 @@ repDoBlock doName maybeModName (MkC ss) = do
coreModNameM = case maybeModName of
Just m -> do
MkC s <- lift $ coreStringLit (moduleNameFS m)
- mName <- rep2_nw mkModNameName [s]
+ mName <- rep2_nw mkModNameOcc [s]
coreJust modNameTyConOcc mName
_ -> coreNothing modNameTyConOcc
@@ -2918,15 +2918,15 @@ repH98DataCon con details
case details of
PrefixCon ps -> do
arg_tys <- repPrefixConArgs IsNotPrefixConGADT ps
- rep2 normalCName [unC con', unC arg_tys]
+ rep2 normalCOcc [unC con', unC arg_tys]
InfixCon st1 st2 -> do
verifyLinearFields IsNotPrefixConGADT [st1, st2]
arg1 <- repConDeclField st1
arg2 <- repConDeclField st2
- rep2 infixCName [unC arg1, unC con', unC arg2]
+ rep2 infixCOcc [unC arg1, unC con', unC arg2]
RecCon ips -> do
arg_vtys <- repRecConArgs ips
- rep2 recCName [unC con', unC arg_vtys]
+ rep2 recCOcc [unC con', unC arg_vtys]
repGadtDataCons :: NonEmpty (LocatedN Name)
-> HsConDeclGADTDetails GhcRn
@@ -2938,11 +2938,11 @@ repGadtDataCons cons details res_ty
PrefixConGADT _ ps -> do
arg_tys <- repPrefixConArgs IsPrefixConGADT ps
res_ty' <- repLTy res_ty
- rep2 gadtCName [ unC (nonEmptyCoreList' cons'), unC arg_tys, unC res_ty']
+ rep2 gadtCOcc [ unC (nonEmptyCoreList' cons'), unC arg_tys, unC res_ty']
RecConGADT _ ips -> do
arg_vtys <- repRecConArgs ips
res_ty' <- repLTy res_ty
- rep2 recGadtCName [unC (nonEmptyCoreList' cons'), unC arg_vtys,
+ rep2 recGadtCOcc [unC (nonEmptyCoreList' cons'), unC arg_vtys,
unC res_ty']
-- TH currently only supports linear constructors.
@@ -3197,15 +3197,15 @@ repRdrName rdr_name = do
-- used for holes anyway so it probably never happens
repNameS :: Core String -> MetaM (Core TH.Name)
-repNameS (MkC name) = rep2_nw mkNameSName [name]
+repNameS (MkC name) = rep2_nw mkNameSOcc [name]
repNameQ :: Core String -> Core String -> MetaM (Core TH.Name)
-repNameQ (MkC mn) (MkC name) = rep2_nw mkNameQName [mn, name]
+repNameQ (MkC mn) (MkC name) = rep2_nw mkNameQOcc [mn, name]
--------------- Miscellaneous -------------------
repGensym :: Core String -> MetaM (Core (M TH.Name))
-repGensym (MkC lit_str) = rep2 newNameName [lit_str]
+repGensym (MkC lit_str) = rep2 newNameOcc [lit_str]
repBindM :: Type -> Type -- a and b
-> Core (M a) -> Core (a -> M b) -> MetaM (Core (M b))
=====================================
compiler/GHC/Rename/Splice.hs
=====================================
@@ -337,10 +337,10 @@ runRnSplice flavour run_meta ppr_res splice
Just h -> h splice
-- TODO: Should call tcUntypedSplice here
- ; let the_expr = case splice' of
- HsUntypedSpliceExpr _ e -> e
- HsQuasiQuote _ q str -> mkQuasiQuoteExpr flavour q str
- XUntypedSplice {} -> pprPanic "runRnSplice: XUntypedSplice" (pprUntypedSplice False Nothing splice')
+ ; the_expr <- case splice' of
+ HsUntypedSpliceExpr _ e -> pure e
+ HsQuasiQuote _ q str -> fst <$> rnLExpr (mkQuasiQuoteExpr flavour q str)
+ XUntypedSplice {} -> pprPanic "runRnSplice: XUntypedSplice" (pprUntypedSplice False Nothing splice')
-- Typecheck the expression
; meta_exp_ty <- tcMetaKnownOccTy meta_ty_name
@@ -392,18 +392,18 @@ recordPendingSplice _ _ (TcPending _ _ _) = panic "impossible"
------------------
mkQuasiQuoteExpr :: UntypedSpliceFlavour -> LIdP GhcRn
-> XRec GhcPs FastString
- -> LHsExpr GhcRn
+ -> LHsExpr GhcPs
-- Return the expression (quoter "...quote...")
-- which is what we must run in a quasi-quote
mkQuasiQuoteExpr flavour quoter (L q_span' quote)
= L q_span $ HsApp noExtField (L q_span
$ HsApp noExtField (L q_span
- (mkHsVar (L (l2l q_span) quote_selector)))
+ (mkHsVar (L (l2l q_span) (Exact (ExactOcc quote_selector)))))
quoterExpr)
quoteExpr
where
q_span = noAnnSrcSpan (locA q_span')
- quoterExpr = L (l2l quoter) $! mkHsVar $! quoter
+ quoterExpr = L (l2l quoter) $! mkHsVar $! Exact . ExactName <$> quoter
quoteExpr = L q_span $! HsLit noExtField $! HsString NoSourceText quote
quote_selector = case flavour of
UntypedExpSplice -> quoteExpName
=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -834,7 +834,7 @@ tcUntypedSplice (QuoteWrapper _ m_var) splice_name (HsQuasiQuote (HsQuasiQuoteEx
res_co <- unifyInvisibleType InvisibleKind splice_ty quote_ty
-- 3. Lookup the relevant field selector from QuasiQuoter
- sel <- tcLookupId qq_sel_name
+ sel <- tcLookupKnownOccId qq_sel_name
-- 4. Apply the selector to the quasi-quoter
let expr' = mkLHsWrapCo res_co $
@@ -877,7 +877,7 @@ tcPendingSpliceTyped q@(QuoteWrapper _ m_var) splice_name (HsTypedSpliceExpr _ e
; let rep = getRuntimeRep res_ty
; meta_exp_ty <- tcCodeTy m_var res_ty
; expr' <- tcCheckMonoExpr expr meta_exp_ty
- ; untype_code <- tcLookupId unTypeCodeName
+ ; untype_code <- tcLookupKnownOccId unTypeCodeOcc
; let expr'' = mkHsApp
(mkLHsWrap (applyQuoteWrapper q)
(nlHsTyApp untype_code [rep, res_ty])) expr'
=====================================
libraries/base/src/GHC/Essentials.hs
=====================================
@@ -195,7 +195,7 @@ module GHC.Essentials
, Lift, Quote -- The Lift and Quote classeso
, Q, DecsQ, ExpQ, TypeQ, PatQ
, Name, Decs, TH.Type, FunDep
- , Pred, Code, InjectivityAnn, Overlap, ModName, QuasiQuoter
+ , Pred, Code, InjectivityAnn, ModName
, Con, BangType, VarBangType, RuleBndr, TySynEqn, Role, DerivClause
, Kind, TyVarBndrUnit, TyVarBndrSpec, TyVarBndrVis, DerivStrategy
, sequenceQ, newName, mkName, mkNameG_v, mkNameG_d, mkNameG_tc, mkNameG_fld, mkNameL
@@ -221,6 +221,9 @@ module GHC.Essentials
, letE, caseE, doE, mdoE, compE, fromE, fromThenE, fromToE, fromThenToE
, listE, sigE, recConE, recUpdE, staticE, unboundVarE, labelE, implicitParamVarE
, getFieldE, projectionE, typeE, forallE, forallVisE, constrainedE
+ , TH.cxt
+ , TH.noSourceUnpackedness, TH.sourceNoUnpack, TH.sourceUnpack
+ , TH.noSourceStrictness, TH.sourceLazy, TH.sourceStrict
, FieldExp, fieldExp
, FieldPat, fieldPat
, Match, match
@@ -228,6 +231,35 @@ module GHC.Essentials
, Stmt, bindS, letS, noBindS, parS, recS
, Body, normalB, guardedB
, Guard, normalGE, patGE
+ , normalC, recC, infixC, forallC, gadtC, recGadtC
+ , TH.bang, TH.bangType, TH.varBangType
+ , TH.unidir, TH.implBidir, TH.explBidir
+ , TH.prefixPatSyn, TH.recordPatSyn, TH.infixPatSyn
+ , forallT, forallVisT, varT, conT, infixT, tupleT,
+ , unboxedTupleT, unboxedSumT, arrowT, mulArrowT, listT,
+ , appT, appKindT, sigT, equalityT, litT, promotedT,
+ , promotedTupleT, promotedNilT, promotedConsT,
+ , wildCardT, implicitParamT
+ , numTyLit, strTyLit, charTyLit
+ , plainTV, kindedTV
+ , plainInvisTV, kindedInvisTV
+ , specifiedSpec, inferredSpec
+ , bndrReq, bndrInvis
+ , nominalR, representationalR, phantomR, inferR
+ , starK, constraintK
+ , noSig, kindSig, tyVarSig
+ , injectivityAnn
+ , TH.cCall, TH.stdCall, TH.cApiCall, TH.primCall, TH.javaScriptCall
+ , TH.unsafe, TH.safe, TH.interruptible
+ , TH.ruleVar, TH.typedRuleVar
+ , TH.funDep, TH.tySynEqn
+ , TH.valueAnnotation, TH.typeAnnotation, TH.moduleAnnotation
+ , TH.derivClause
+ , TH.stockStrategy, TH.anyclassStrategy, TH.newtypeStrategy, TH.viaStrategy
+ , TH.QuasiQuoter(..)
+ , TH.Inline(..), TH.RuleMatch(..)
+ , TH.Phases(..) , TH.Overlap(..)
+ , TH.NamespaceSpecifier(..)
-- GHCi
, GHCiSandboxIO(ghciStepIO)
@@ -298,7 +330,7 @@ import GHC.Internal.TH.Syntax as TH
hiding( Fixity(..), SourceUnpackedness(..), SourceStrictness(..)
, DecidedStrictness(..) )
-- hiding(Fixity) see Note [Tricky known-occ cases] in GHC.Builtin.KnownOccs
-import GHC.Internal.TH.Lib
+import GHC.Internal.TH.Lib as TH
import GHC.Internal.TH.Lift
import GHC.Internal.TH.Monad
import GHC.Internal.TopHandler
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cec620e84ff1f6bb18ed942c2f13e8…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cec620e84ff1f6bb18ed942c2f13e8…
You're receiving this email because of your account on gitlab.haskell.org.
1
0