[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: loopImports: Don't dup ms_uid in summary imports
by Marge Bot (＠marge-bot) 15 Aug '26
by Marge Bot (＠marge-bot) 15 Aug '26
15 Aug '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
39720029 by Rodrigo Mesquita at 2026-08-14T21:32:13-04:00
loopImports: Don't dup ms_uid in summary imports
We were writing the ms_unitid of the mod summary with every single
import of that module
That complicated the code (as though the UnitId in that list could ever
be something else) and also allocates unnecessarily per every mod
import. Very slight allocation decrease measured locally in a few tests:
(MultiComponentModulesRecomp: -0.06%; MultiComponentModulesRecomp100: -0.05%)
Purely a clean up.
- - - - -
3904d06a by Rodrigo Mesquita at 2026-08-14T21:32:13-04:00
downsweep: make control flow simpler and cache correct
This refactor extracts the control flow of downsweep into a single
function `dfsBuild`, which takes care of iteratively expanding and
traversing all nodes of the in-construction module graph necessary to
build a full `ModuleGraph`.
There are three levels of caching going on, all of which are necessary
to make sure we don't do repeated work (notably, NEVER summarise the
same module twice).
1. `dfsBuild` accumulates the final module graph and never revisits the
same node of the module graph. Cache is keyed by the final
`ModuleGraph`s `NodeKey`s.
2. For Module A in home-unit u1, each import in the list of imports
needs to be *found* (call to `findImportedModuleWithIsBoot`): at this
point, we only have the `ModuleName` of the import, not the `Module`.
This *finding* is somewhat expensive, so we cache it as well
(`ImportsCache`). The cache key is the home-unit to which the module
belongs~[1], the import package qualifier, and the ModuleName.
[1] Different home-units will have different package flags, which means
potentially different `Module` resolution for the same `ModuleName`.
3. The most expensive operation we want to avoid is summarising a
`Module` into a `ModSummary`, which notably involves parsing the
module header from scratch.
The third cache, in essence, maps a `Module` to its `ModSummary`
(named `ModSummaryCache`). This cache upholds the invariant: we NEVER
summarise the same module twice. In practice, the cache key is the
Module's UnitId and the Source path; the reason is we need to
distinguish between `.hs` and `.hs-boot` files, as their summaries
will differ.
Note that (2) can't guarantee this alone: Two ModuleName imports in
separate units can (and likely do) map to the same `Module`.
Note that the previous implementation failed to achieve the
no-duplicate-work summarisation invariant, and we ended up doing a
quadratic amount of processing in scenarios like test
`MultiComponentModules100`.
See also Note [Downsweep Control Flow and Caching]
Fixes #27461
Perf changes:
MultiComponentModules(normal) ghc/alloc 2,097,389,264 1,992,186,736 -5.0% GOOD
MultiComponentModules100(normal) ghc/alloc 24,310,173,770 21,293,867,360 -12.4% GOOD
MultiComponentModulesRecomp(normal) ghc/alloc 602,761,394 498,543,984 -17.3% GOOD
MultiComponentModulesRecomp100(normal) ghc/alloc 11,885,968,240 8,895,404,864 -25.2% GOOD
-------------------------
Metric Decrease:
MultiComponentModules
MultiComponentModules100
MultiComponentModulesRecomp
MultiComponentModulesRecomp100
-------------------------
- - - - -
f8bbd057 by Rodrigo Mesquita at 2026-08-14T21:32:13-04:00
implicitRequirementsShallow can never reach HoleUnit
findImportedModule will never return `HoleUnit` for a `ModuleName`
(a `HoleUnit` can only be found as a signature instantiation, never as a
directly *imported* thing)
Therefore, we can drop `[ModuleName]` returned by
`implicitRequirementsShallow`, which makes many things dead code.
Namely, the call to `implicitRequirementsShallow` from
GHC.Driver.Downsweep which was a performance bottleneck (for doing lots
of duplicate work in findImportedModule) is now entirely gone.
Fixes #27053
In an MR with this patch and the downsweep refactor (previous commit), CI says:
MultiComponentModules(normal) ghc/alloc 2,097,396,728 1,943,662,304 -7.3% GOOD
MultiComponentModules100(normal) ghc/alloc 24,310,182,136 17,227,574,440 -29.1% GOOD
MultiComponentModulesRecomp(normal) ghc/alloc 602,769,518 449,973,656 -25.3% GOOD
MultiComponentModulesRecomp100(normal) ghc/alloc 11,885,976,408 4,828,894,160 -59.4% GOOD
-------------------------
Metric Decrease:
MultiComponentModules
MultiComponentModules100
MultiComponentModulesRecomp
MultiComponentModulesRecomp100
-------------------------
- - - - -
6c3c3086 by Rodrigo Mesquita at 2026-08-14T21:32:13-04:00
downsweep: Cache negative results
When traversing a module graph structure, a uniquely identified node
should always expand to the same thing.
I don't see how visiting the same node which failed to be expanded a
first time would ever successfully expand the second time we try to
expand it (eg. when coming from a different edge to it -- it is still
the same node!). The node expansion is local, based just based on the
node itself, not on the path to get there.
Therefore, this patch removes the weird behavior and commentary of
`dfsBuild` wrt to `Nothing` not being cached and being potentially
expanded a second time around to something different, which was
misleading and, ultimately, incorrect.
Now, we have a `MGRes`, which is more explicit about a node being
Skipped just being a node that is ignored whenever it is found (and that
skip is cached) -- and we may want to do this due to failures or due to
just trying nodes which might not work on purpose, like hs-boots.
We uniformly cache positive and negative results and remove the
assumption that there might be an ordering in which the same node
visited at a later time might be expanded differently.
This makes it possible to traverse the module nodes in parallel without
a change in behavior, since there's no longer a hidden ordering
requirement.
- - - - -
fabfe4bc by Rodrigo Mesquita at 2026-08-14T21:32:13-04:00
Organize and clean-up GHC.Driver.Downsweep
Simply some cosmetic changes, moving definitions around to structure the
module better into its relevant sections
(In go (ns ++ ss), it's not a problem to use ++ because it's a good
producer and we won't have to append fully before processing the next
item in go)
- - - - -
9c094539 by Wolfgang Jeltsch at 2026-08-14T21:32:14-04:00
Add support for textual output of bytecode file content
- - - - -
6e553d0b by mangoiv at 2026-08-14T21:32:15-04:00
hadrian: set the executable bit for hie-bios.bat
- - - - -
37 changed files:
- + changelog.d/downsweep-refactor
- + changelog.d/show-byte-code
- compiler/GHC/ByteCode/Serialize.hs
- + compiler/GHC/ByteCode/Show.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/Unit/Env.hs
- compiler/ghc.cabal.in
- docs/users_guide/using.rst
- ghc/GHC/Driver/Session/Mode.hs
- ghc/Main.hs
- hadrian/hie-bios.bat
- + testsuite/tests/driver/T27461/Main1.hs
- + testsuite/tests/driver/T27461/Main2.hs
- + testsuite/tests/driver/T27461/Makefile
- + testsuite/tests/driver/T27461/T27461a.stderr
- + testsuite/tests/driver/T27461/T27461b.script
- + testsuite/tests/driver/T27461/T27461b.stderr
- + testsuite/tests/driver/T27461/T27461b.stdout
- + testsuite/tests/driver/T27461/all.T
- + testsuite/tests/driver/T27461/src/Bar.hs
- testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
- testsuite/tests/ghc-api/fixed-nodes/InterfaceModuleGraph.hs
- testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
- + testsuite/tests/show-bytecode/Example.hs
- + testsuite/tests/show-bytecode/Makefile
- + testsuite/tests/show-bytecode/all.T
- + testsuite/tests/show-bytecode/normalize
- + testsuite/tests/show-bytecode/show-bytecode-breakpoints.stdout
- + testsuite/tests/show-bytecode/show-bytecode-breakpoints.stdout-javascript-unknown-ghcjs
- + testsuite/tests/show-bytecode/show-bytecode-hpc.stdout
- + testsuite/tests/show-bytecode/show-bytecode-vanilla.stdout
- + testsuite/tests/show-bytecode/show-bytecode-vanilla.stdout-javascript-unknown-ghcjs
- testsuite/tests/splice-imports/SI35.hs
- utils/check-ppr/Main.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/05aee047ad3659b1eee454e1a2bee7…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/05aee047ad3659b1eee454e1a2bee7…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
15 Aug '26
Vladislav Zavialov pushed new branch wip/int-index/T7803 at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/int-index/T7803
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
14 Aug '26
Simon Jakobi pushed new branch wip/sjakobi/T27602 at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sjakobi/T27602
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/romes/27514] Concurrent worker abstraction for downsweep/make
by sheaf (＠sheaf) 14 Aug '26
by sheaf (＠sheaf) 14 Aug '26
14 Aug '26
sheaf pushed to branch wip/romes/27514 at Glasgow Haskell Compiler / GHC
Commits:
566d789d by sheaf at 2026-08-14T23:26:51+02:00
Concurrent worker abstraction for downsweep/make
This commit introduces GHC.Driver.Concurrency which provides a high-level
interface over scheduling concurrent workers, used by downsweep and
--make.
Summary of changes:
- The ad-hoc plumbing of AbstractSem is replaced by the dedicated
'data Concurrency = Serial | Concurrent ConcurrencyEnv'.
This avoids a footgun in which one could try to use an 'AbstractSem'
as a lock in the serial case.
- We no longer wastefully re-run an entire action upon a semaphore
failure. The "fallback to -j1" logic is preserved, but it only
applies to the initial attempt at opening a semaphore, not on late
semaphore errors that occur partway through a lengthy computation.
- Logger threads are now properly cleaned up on exception.
- Drop the 'GhcMessage -> AnyGhcDiagnostic' and 'Maybe Messager'
arguments to 'depanalE', 'depanalPartial' and 'downsweep', which
were all dead in practice.
- - - - -
9 changed files:
- + compiler/GHC/Driver/Concurrency.hs
- + compiler/GHC/Driver/Config/Concurrency.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/MakeAction.hs
- compiler/GHC/Driver/MakeSem.hs
- compiler/GHC/Utils/TmpFs.hs
- compiler/ghc.cabal.in
- utils/haddock/haddock-api/src/Haddock/Interface.hs
Changes:
=====================================
compiler/GHC/Driver/Concurrency.hs
=====================================
@@ -0,0 +1,464 @@
+{-# LANGUAGE CPP #-}
+
+{-# LANGUAGE BlockArguments #-}
+
+module GHC.Driver.Concurrency
+ ( -- * Worker limit and concurrency
+ WorkerLimit(..)
+ , isWorkerLimitSequential
+ , withWorkerLimit
+ , Concurrency
+ , withConcurrency
+ -- * Concurrent worker scheduling
+ , ConcurrentWorkerEnv(..)
+ , mapConcurrentWorkers
+ , concurrentTraversal_DF
+ )
+ where
+
+import GHC.Prelude
+
+import GHC.Driver.MakeSem
+import GHC.Driver.Pipeline.LogQueue
+ ( LogQueueQueue, finishLogQueue, initLogQueue, logThread
+ , newLogQueue, newLogQueueQueue, parLogAction )
+import GHC.Utils.Logger
+ ( Logger, makeThreadSafe, pushLogHook )
+import GHC.Utils.Panic
+ ( panic )
+import GHC.Utils.TmpFs
+ ( TmpFs, forkTmpFsFrom, mergeTmpFsInto, withLocalTmpFS )
+
+import System.Semaphore
+ ( SemaphoreError, SemaphoreIdentifier )
+
+#if defined(wasm32_HOST_ARCH) || defined(javascript_HOST_ARCH)
+import Control.Concurrent
+ ( ThreadId, forkIOWithUnmask, killThread, myThreadId )
+import Control.Concurrent.MVar
+ ( MVar, newEmptyMVar, newMVar, putMVar, takeMVar )
+import GHC.Conc
+ ( labelThread )
+#else
+import Control.Concurrent
+ ( ThreadId, forkIOWithUnmask, killThread, myThreadId
+ , newQSem, signalQSem, waitQSem, MVar, takeMVar, putMVar, newEmptyMVar )
+import Control.Monad
+ ( unless )
+import qualified Control.Monad.Catch as MC
+import GHC.Conc
+ ( getNumCapabilities, getNumProcessors, labelThread, setNumCapabilities )
+#endif
+import Control.Concurrent.STM
+ ( TVar, atomically, check, modifyTVar', newTVarIO, readTVar, writeTVar )
+import Control.Exception
+ ( AsyncException(ThreadKilled), SomeAsyncException, SomeException
+ , finally, fromException, mask, mask_, onException
+ , throwIO, try, uninterruptibleMask_ )
+import Control.Monad
+ ( replicateM )
+import Data.Foldable
+ ( for_ )
+import Data.IORef
+ ( IORef, atomicModifyIORef', modifyIORef', newIORef, readIORef, writeIORef )
+import qualified Data.Map as Map
+import qualified Data.Sequence as Seq
+import qualified Data.Set as Set
+
+--------------------------------------------------------------------------------
+-- * Worker Limit
+--------------------------------------------------------------------------------
+
+-- | A limit on the number of concurrent worker threads.
+data WorkerLimit
+ -- | Fixed concurrent worker count limit @-jN@
+ = NumProcessorsLimit Int
+ -- | The concurrent worker count is limited by a @-jsem@ semaphore
+ | JSemLimit
+ SemaphoreIdentifier
+ -- ^ Semaphore identifier (from the @semaphore-compat@ library)
+ deriving Eq
+
+isWorkerLimitSequential :: WorkerLimit -> Bool
+isWorkerLimitSequential (NumProcessorsLimit x) = x <= 1
+isWorkerLimitSequential (JSemLimit {}) = False
+
+runWorkerLimit
+ :: (SemaphoreError -> IO ())
+ -- ^ report failure when opening the @-jsem@ semaphore
+ -- (after which we fall back to running with a single job)
+ -> WorkerLimit -> (AbstractSem -> IO a) -> IO a
+#if defined(wasm32_HOST_ARCH) || defined(javascript_HOST_ARCH)
+runWorkerLimit _report_semaphore_failure _ action = do
+ lock <- newMVar ()
+ action $ AbstractSem (takeMVar lock) (putMVar lock ())
+#else
+runWorkerLimit report_semaphore_failure worker_limit action = case worker_limit of
+ NumProcessorsLimit n_jobs ->
+ runNjobsAbstractSem n_jobs action
+ JSemLimit sem_ident ->
+ runJSemAbstractSem sem_ident action >>= \case
+ Right a -> return a
+ Left err -> do
+ report_semaphore_failure err
+ runNjobsAbstractSem 1 action
+#endif
+
+#if !(defined(wasm32_HOST_ARCH) || defined(javascript_HOST_ARCH))
+runNjobsAbstractSem :: Int -> (AbstractSem -> IO a) -> IO a
+runNjobsAbstractSem n_jobs action = do
+ compile_sem <- newQSem n_jobs
+ n_capabilities <- getNumCapabilities
+ n_cpus <- getNumProcessors
+ let
+ asem = AbstractSem (waitQSem compile_sem) (signalQSem compile_sem)
+ set_num_caps n = unless (n_capabilities /= 1) $ setNumCapabilities n
+ updNumCapabilities = do
+ -- Setting number of capabilities more than
+ -- CPU count usually leads to high userspace
+ -- lock contention. #9221
+ set_num_caps $ min n_jobs n_cpus
+ resetNumCapabilities = set_num_caps n_capabilities
+ MC.bracket_ updNumCapabilities resetNumCapabilities $ action asem
+
+#endif
+
+--------------------------------------------------------------------------------
+-- * Workers
+--------------------------------------------------------------------------------
+
+data Concurrency
+ = Serial
+ | Concurrent !ConcurrencyEnv
+
+-- | Run an action with the given concurrency control (serial or concurrent).
+withConcurrency :: Concurrency -> IO a -> IO a
+withConcurrency conc act =
+ case conc of
+ Serial -> act
+ Concurrent ( ConcurrencyEnv { ce_semaphore } ) ->
+ withAbstractSem ce_semaphore act
+
+data ConcurrencyEnv =
+ ConcurrencyEnv
+ { ce_semaphore :: !AbstractSem
+ , ce_log_queue_queue :: !( TVar LogQueueQueue )
+ , ce_next_log_queue_id :: !( IORef Int )
+ }
+
+-- | The local environment of a worker thread that may be scheduled concurrently.
+data ConcurrentWorkerEnv = ConcurrentWorkerEnv
+ { cwe_logger :: !Logger
+ , cwe_tmpfs :: !TmpFs
+ }
+
+-- | Run an action with a local 'TmpFs', merging in the resulting temporary file
+-- accumulator into the parent afterwards.
+workerEnv_withLocalTmpFS :: ConcurrentWorkerEnv -> (ConcurrentWorkerEnv -> IO a) -> IO a
+workerEnv_withLocalTmpFS env use =
+ withLocalTmpFS (cwe_tmpfs env) \ lcl_tmpfs ->
+ use env { cwe_tmpfs = lcl_tmpfs }
+
+-- | Run an action either serially or concurrently based on the provided
+-- 'WorkerLimit'.
+withWorkerLimit
+ :: Logger
+ -> TmpFs
+ -> (SemaphoreError -> IO ())
+ -- ^ report a failure to open the @-jsem@ semaphore
+ -- (after which we fall back to running with a single job)
+ -> WorkerLimit
+ -> (Concurrency -> ConcurrentWorkerEnv -> IO a) -- ^ action to run
+ -> IO a
+withWorkerLimit logger tmpfs report_semaphore_failure limit action
+ | isWorkerLimitSequential limit
+ = action Serial $
+ ConcurrentWorkerEnv
+ { cwe_logger = logger
+ , cwe_tmpfs = tmpfs
+ }
+ | otherwise
+ = do
+ safe_logger <- makeThreadSafe logger
+ lqq_var <- newTVarIO newLogQueueQueue
+ stopped_var <- newTVarIO False
+ wait_log_thread <- logThread safe_logger stopped_var lqq_var
+ next_logq_var <- newIORef 1
+
+ let
+ stop_logging :: IO ()
+ stop_logging = do
+ atomically $ writeTVar stopped_var True
+ wait_log_thread
+
+ parent_work_env :: ConcurrentWorkerEnv
+ parent_work_env =
+ ConcurrentWorkerEnv
+ { cwe_logger = safe_logger
+ , cwe_tmpfs = tmpfs
+ }
+
+ ( `finally` stop_logging ) $
+ runWorkerLimit report_semaphore_failure limit \ sem -> do
+ let
+ conc =
+ Concurrent $
+ ConcurrencyEnv
+ { ce_semaphore = sem
+ , ce_log_queue_queue = lqq_var
+ , ce_next_log_queue_id = next_logq_var
+ }
+ action conc parent_work_env
+
+--------------------------------------------------------------------------------
+-- * Scheduling concurrent workers
+--------------------------------------------------------------------------------
+
+-- | Internal scheduler abstraction with two capabilities:
+--
+-- - spawn a new worker thread
+-- - wait for a worker thread to complete
+data Scheduler r = Scheduler
+ { spawnWorker :: (ConcurrentWorkerEnv -> IO r) -> IO ()
+ -- ^ Spawn one concurrent worker.
+ --
+ -- The worker does not hold a token of the concurrency semaphore: the
+ -- worker action should use 'withConcurrency' around the work whose
+ -- concurrency should be limited.
+ , awaitWorker :: IO (Either SomeException r)
+ -- ^ Wait for one worker to complete.
+ --
+ -- Will crash if there are no outstanding workers.
+ }
+
+-- | Internal implementation of a concurrent worker scheduler.
+--
+-- Usage of this function requires the following:
+--
+-- - all spawn/await actions are performed by a single thread,
+-- - we never wait for more workers than were spawned,
+-- - no worker outlives 'run_schedule'.
+run_schedule
+ :: forall r a
+ . String
+ -- ^ thread label for workers
+ -> Concurrency
+ -> ConcurrentWorkerEnv
+ -> (Scheduler r -> IO a)
+ -- ^ worker action
+ -> IO a
+run_schedule worker_label conc parent_work_env withScheduler =
+ case conc of
+
+ Serial -> do
+ results_var <- newIORef Seq.empty
+ let
+ spawnWorker :: (ConcurrentWorkerEnv -> IO r) -> IO ()
+ spawnWorker action = do
+ res <- try @SomeException $
+ workerEnv_withLocalTmpFS parent_work_env action
+ case res of
+ Left e
+ | Just _ <- fromException @SomeAsyncException e
+ -> throwIO e
+ _ -> modifyIORef' results_var (Seq.|> res)
+
+ awaitWorker :: IO (Either SomeException r)
+ awaitWorker =
+ readIORef results_var >>= \case
+ res Seq.:<| rest -> do
+ writeIORef results_var rest
+ pure res
+ Seq.Empty ->
+ panic "run_schedule: no outstanding job"
+
+ withScheduler $ Scheduler { spawnWorker, awaitWorker }
+
+ Concurrent ( ConcurrencyEnv { ce_next_log_queue_id, ce_log_queue_queue } ) -> do
+ worker_tids_var <- newTVarIO $ Set.empty @ThreadId
+ all_results_vars_var <- newIORef $ Seq.empty @(MVar (Either SomeException r))
+
+ let
+ wait_for_workers :: IO ()
+ wait_for_workers =
+ atomically $
+ check . Set.null =<< readTVar worker_tids_var
+
+ cancel_workers :: IO ()
+ cancel_workers = do
+ uninterruptibleMask_ do
+ tids <- atomically $ readTVar worker_tids_var
+ for_ tids killThread
+ wait_for_workers
+
+ awaitWorker :: IO (Either SomeException r)
+ awaitWorker =
+ readIORef all_results_vars_var >>= \case
+ first_worker_res_var Seq.:<| rest -> do
+ writeIORef all_results_vars_var rest
+ -- block on the earliest-spawned outstanding worker
+ takeMVar first_worker_res_var
+ Seq.Empty ->
+ panic "run_schedule: no outstanding job"
+
+ spawnWorker :: (ConcurrentWorkerEnv -> IO r) -> IO ()
+ spawnWorker action = mask_ do
+
+ worker_res_var <- newEmptyMVar
+
+ -- TmpFs
+ lcl_tmpfs <- forkTmpFsFrom (cwe_tmpfs parent_work_env)
+
+ -- LogQueue
+ lq <- do
+ job_id <- atomicModifyIORef' ce_next_log_queue_id \n -> (n + 1, n)
+ lq <- newLogQueue job_id
+ atomically $ initLogQueue ce_log_queue_queue lq
+ pure lq
+
+ let
+
+ worker_work_env :: ConcurrentWorkerEnv
+ worker_work_env =
+ parent_work_env
+ { cwe_tmpfs = lcl_tmpfs
+ , cwe_logger = pushLogHook (const (parLogAction lq))
+ (cwe_logger parent_work_env)
+ }
+
+ -- Run a worker action and record its result.
+ run_worker_and_record :: IO r -> IO ()
+ run_worker_and_record worker_action = do
+ res <- try @SomeException worker_action
+ case res of
+ Left e
+ -- Worker is being cancelled: don't record anything.
+ | Just ThreadKilled <- fromException e
+ -> pure ()
+ _ -> putMVar worker_res_var res
+
+ -- Record that a worker thread is done.
+ mark_worker_done :: ThreadId -> IO ()
+ mark_worker_done tid =
+ uninterruptibleMask_ do
+ -- Uninterruptible: the deletion below /must/ occur.
+ -- An uninterruptible mask is OK as we only ever block for (GAP) below.
+ mergeTmpFsInto lcl_tmpfs $ cwe_tmpfs parent_work_env
+ finishLogQueue lq
+ atomically do
+ tids <- readTVar worker_tids_var
+ check $ tid `Set.member` tids
+ -- Ensure we never end up with a dead ThreadId in 'worker_tids_var'
+ -- (if the worker thread finishes before the parent thread has
+ -- the time to add its ThreadId to 'worker_tids_var').
+
+ writeTVar worker_tids_var $ Set.delete tid tids
+
+ run_worker :: (forall b. IO b -> IO b) -> IO ()
+ run_worker unmask = do
+ tid <- myThreadId
+ labelThread tid worker_label
+ let
+ worker_action :: IO r
+ worker_action = unmask $ action worker_work_env
+
+ run_worker_and_record worker_action `finally`
+ mark_worker_done tid
+
+ worker_tid <-
+ forkIOWithUnmask run_worker
+ `onException` finishLogQueue lq
+ -- Very short (GAP) between forking the thread and recording its ThreadId.
+ atomically $ modifyTVar' worker_tids_var $ Set.insert worker_tid
+ modifyIORef' all_results_vars_var (Seq.|> worker_res_var)
+
+ mask \ restore -> do
+ result <- restore (withScheduler $ Scheduler { spawnWorker, awaitWorker })
+ `onException` cancel_workers
+ restore wait_for_workers `onException` cancel_workers
+ pure result
+
+--------------------------------------------------------------------------------
+-- * Derived scheduling functionality
+--------------------------------------------------------------------------------
+
+-- | Map a worker action over the input list with the given concurrency control.
+--
+-- Workers run to completion (no early abort); the first exception
+-- (in input order) is rethrown at the end.
+mapConcurrentWorkers
+ :: String -- ^ thread label for workers
+ -> Concurrency
+ -> ConcurrentWorkerEnv
+ -> (ConcurrentWorkerEnv -> a -> IO b)
+ -- ^ individual worker action
+ --
+ -- NB: workers do not hold semaphore tokens by default; use
+ -- 'withConcurrency' to acquire one
+ -> [a]
+ -> IO [b]
+mapConcurrentWorkers worker_label conc work_env f xs =
+ run_schedule worker_label conc work_env \ scheduler -> do
+ for_ xs \ x -> spawnWorker scheduler \ worker_env -> f worker_env x
+ results <- replicateM (length xs) (awaitWorker scheduler)
+ either throwIO pure (sequence results)
+
+-- | Depth-first traversal with on-the-fly expansion of nodes.
+--
+-- Each expansion step is handled by a worker thread under the given
+-- concurrency control.
+--
+-- Deterministic: expansions are consumed in the order the nodes were
+-- discovered, so the traversal is a function of the node graph alone.
+--
+-- Fails fast: the first worker exception cancels the outstanding workers and
+-- is rethrown.
+concurrentTraversal_DF
+ :: forall k n r
+ . Ord k
+ => String -- ^ thread label for workers
+ -> Concurrency
+ -> ConcurrentWorkerEnv
+ -> Map.Map k r
+ -- ^ results known ahead of time (no expansion needed)
+ -> [n]
+ -- ^ root nodes
+ -> (n -> k)
+ -- ^ node key from node
+ -> (ConcurrentWorkerEnv -> n -> IO (r, [n]))
+ -- ^ worker action: expand a node into its result and the children to visit next
+ --
+ -- NB: workers do not hold semaphore tokens by default; use
+ -- 'withConcurrency' to acquire one
+ -> IO (Map.Map k r)
+concurrentTraversal_DF worker_label conc work_env base_map roots key expand =
+ run_schedule worker_label conc work_env \ scheduler -> do
+ let
+ expand_node :: n -> ConcurrentWorkerEnv -> IO (k, (r, [n]))
+ expand_node node worker_env = do
+ res <- expand worker_env node
+ pure (key node, res)
+
+ go
+ :: Map.Map k r -- expanded nodes and their results
+ -> Set.Set k -- nodes currently being expanded
+ -> [n] -- discovered nodes, to expand next
+ -> IO (Map.Map k r)
+ go !visited !pending (node : worklist)
+ | k `Set.member` pending || k `Map.member` visited
+ = go visited pending worklist
+ | otherwise
+ = do spawnWorker scheduler (expand_node node)
+ go visited (Set.insert k pending) worklist
+ where
+ k = key node
+ go visited pending []
+ | Set.null pending
+ = pure visited
+ | otherwise
+ = awaitWorker scheduler >>= \case
+ Left e -> throwIO e
+ Right (k, (result, children)) ->
+ go (Map.insert k result visited) (Set.delete k pending) children
+
+ go base_map Set.empty roots
=====================================
compiler/GHC/Driver/Config/Concurrency.hs
=====================================
@@ -0,0 +1,41 @@
+-- | Subsystem configuration for 'GHC.Driver.Concurrency'.
+module GHC.Driver.Config.Concurrency
+ ( mkWorkerLimit
+ , semaphoreOpenFailureHandler
+ ) where
+
+import GHC.Prelude
+
+import GHC.Driver.Concurrency
+import GHC.Driver.Config.Diagnostic ( initDiagOpts, initPrintConfig )
+import GHC.Driver.DynFlags
+import GHC.Driver.Errors ( printOrThrowDiagnostics )
+import GHC.Driver.Errors.Types
+
+import GHC.Types.Error ( singleMessage )
+import GHC.Types.SrcLoc ( noSrcSpan )
+import GHC.Utils.Error ( mkPlainMsgEnvelope )
+import GHC.Utils.Logger ( Logger )
+
+import GHC.Conc ( getNumProcessors )
+import System.Semaphore ( SemaphoreError )
+
+--------------------------------------------------------------------------------
+
+-- | Compute the 'WorkerLimit' from the @-j@\/@-jsem@ flags.
+mkWorkerLimit :: DynFlags -> IO WorkerLimit
+mkWorkerLimit dflags =
+ case parMakeCount dflags of
+ Nothing -> pure $ num_procs 1
+ Just (ParMakeSemaphore h) -> pure (JSemLimit h)
+ Just ParMakeNumProcessors -> num_procs <$> getNumProcessors
+ Just (ParMakeThisMany n) -> pure $ num_procs n
+ where
+ num_procs x = NumProcessorsLimit (max 1 x)
+
+-- | Report that the semaphore specified using the @-jsem@ flag could not be opened.
+semaphoreOpenFailureHandler :: Logger -> DynFlags -> SemaphoreError -> IO ()
+semaphoreOpenFailureHandler logger dflags err = do
+ let diag = DriverSemaphoreOpenFailure (checkBuildingCabalPackage dflags) err
+ msg = singleMessage $ mkPlainMsgEnvelope (initDiagOpts dflags) noSrcSpan diag
+ printOrThrowDiagnostics logger (initPrintConfig dflags) (initDiagOpts dflags) (GhcDriverMessage <$> msg)
=====================================
compiler/GHC/Driver/Downsweep.hs
=====================================
@@ -40,9 +40,9 @@ import GHC.Driver.Monad
import GHC.Driver.Env
import GHC.Driver.Errors
import GHC.Driver.Errors.Types
-import GHC.Driver.Messager
-import GHC.Driver.MakeSem
+import GHC.Driver.Concurrency
import GHC.Driver.MakeAction
+import GHC.Driver.Config.Concurrency
import GHC.Driver.Config.Diagnostic
import GHC.Driver.Ppr
@@ -64,7 +64,6 @@ import GHC.Data.OsPath ( OsPath, unsafeEncodeUtf )
import GHC.Data.StringBuffer
import GHC.Data.Graph.Directed.Reachability
-import GHC.Utils.Exception ( throwIO, SomeAsyncException, AsyncException (..) )
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Misc
@@ -101,7 +100,6 @@ import qualified Data.Set as Set
import Control.Concurrent.MVar
import Control.Monad
import Control.Monad.Trans.Except ( ExceptT(..), runExceptT, throwE )
-import qualified Control.Monad.Catch as MC
import Data.Maybe
import Data.List (partition)
import Data.Time
@@ -112,13 +110,8 @@ import System.FilePath
import Control.Monad.Trans.Reader
import qualified Data.Map.Strict as M
-import Control.Monad.Trans.Class
import System.IO.Unsafe (unsafeInterleaveIO)
import qualified Data.List.NonEmpty as NE
-import Control.Concurrent
-import Control.Concurrent.STM.TQueue
-import Control.Concurrent.STM
-import Control.Applicative
{-
Note [The ModuleGraph]
@@ -245,8 +238,6 @@ See Note [The ModuleGraph] for an overview when we do downsweep.
--
-- See also Note [The ModuleGraph]
downsweep :: HscEnv
- -> (GhcMessage -> AnyGhcDiagnostic)
- -> Maybe Messager
-> [ModSummary]
-- ^ Old summaries
-> Maybe ModuleGraph
@@ -260,13 +251,14 @@ downsweep :: HscEnv
-- The non-error elements of the returned list all have distinct
-- (Modules, IsBoot) identifiers, unless the Bool is true in
-- which case there can be repeats
-downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allow_dup_roots = do
+downsweep hsc_env old_summaries maybe_base_graph excl_mods allow_dup_roots = do
n_jobs <- mkWorkerLimit (hsc_dflags hsc_env)
summ_cache <- newMVar (mkModSummaryCache (zip old_summaries (repeat SummOld)))
imps_cache <- newMVar Map.empty
- withMakeEnv n_jobs hsc_env diag_wrapper msg $ \make_env -> do
- (root_errs, root_summaries) <- rootSummariesParallel n_jobs make_env (hsc_targets hsc_env)
- (getRootSummary excl_mods summ_cache imps_cache)
+ withWorkerLimitHsc hsc_env n_jobs $ \conc hsc_env' -> do
+ (root_errs, root_summaries) <-
+ rootSummariesParallel conc hsc_env' (hsc_targets hsc_env)
+ (getRootSummary excl_mods summ_cache imps_cache)
let closure_errs = checkHomeUnitsClosed unit_env
unit_env = hsc_unit_env hsc_env
@@ -275,13 +267,12 @@ downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allo
case all_errs of
[] -> do
let env = DownsweepEnv
- { ds_hsc_env = hsc_env
+ { ds_hsc_env = hsc_env'
, ds_summaries_cache = summ_cache
, ds_imports_cache = imps_cache
, ds_mode = DownsweepUseCompile
, ds_excl_mods = excl_mods
- , ds_n_jobs = n_jobs
- , ds_make_env = make_env
+ , ds_concurrency = conc
}
(downsweep_errs, downsweep_nodes) <- runDownsweepM env $
downsweepFromRootNodes maybe_base_graph allow_dup_roots
@@ -349,15 +340,14 @@ downsweepThunk hsc_env mod_summary = unsafeInterleaveIO $ do
njobs <- mkWorkerLimit (hsc_dflags hsc_env)
summs <- newMVar (mkModSummaryCache [(mod_summary,SummOld)])
imps <- newMVar mempty
- withMakeEnv njobs hsc_env mkUnknownDiagnostic Nothing $ \make_env -> do
+ withWorkerLimitHsc hsc_env njobs $ \conc hsc_env' -> do
let env = DownsweepEnv
- { ds_hsc_env = hsc_env
+ { ds_hsc_env = hsc_env'
, ds_summaries_cache = summs
, ds_imports_cache = imps
, ds_mode = DownsweepUseFixed
, ds_excl_mods = []
- , ds_n_jobs = njobs
- , ds_make_env = make_env
+ , ds_concurrency = conc
}
~(errs, mg) <- runDownsweepM env $
downsweepFromRootNodes Nothing True
@@ -394,15 +384,14 @@ downsweepInteractiveImports hsc_env ic = unsafeInterleaveIO $ do
n_jobs <- mkWorkerLimit (hsc_dflags hsc_env)
summ_cache <- newMVar mempty
imps_cache <- newMVar mempty
- withMakeEnv n_jobs hsc_env mkUnknownDiagnostic Nothing $ \make_env -> do
+ withWorkerLimitHsc hsc_env n_jobs $ \conc hsc_env' -> do
let env = DownsweepEnv
- { ds_hsc_env = hsc_env
+ { ds_hsc_env = hsc_env'
, ds_mode = DownsweepUseFixed{-or DownsweepUseCompile?-}
, ds_summaries_cache = summ_cache
, ds_imports_cache = imps_cache
, ds_excl_mods = []
- , ds_n_jobs = n_jobs
- , ds_make_env = make_env
+ , ds_concurrency = conc
}
graph <- runDownsweepM env do
loopFromInteractive cached_nodes interactive_mn imps
@@ -439,15 +428,14 @@ downsweepInstalledModules hsc_env mods = do
nodes <- mapM process installed_mods
summs <- newMVar mempty
imps <- newMVar mempty
- withMakeEnv njobs hsc_env mkUnknownDiagnostic Nothing $ \make_env -> do
+ withWorkerLimitHsc hsc_env njobs $ \conc hsc_env' -> do
let env = DownsweepEnv
- { ds_hsc_env = hsc_env
+ { ds_hsc_env = hsc_env'
, ds_summaries_cache = summs
, ds_imports_cache = imps
, ds_mode = DownsweepUseFixed
, ds_excl_mods = []
- , ds_n_jobs = njobs
- , ds_make_env = make_env
+ , ds_concurrency = conc
}
(errs, mg) <- runDownsweepM env $
downsweepFromRootNodes Nothing True nodes external_uids
@@ -562,8 +550,8 @@ data DownsweepEnv = DownsweepEnv {
, ds_summaries_cache :: ModSummaryCache
, ds_imports_cache :: ImportsCache
, ds_excl_mods :: [ModuleName]
- , ds_n_jobs :: WorkerLimit
- , ds_make_env :: MakeEnv
+ , ds_concurrency :: Concurrency
+ -- ^ The concurrency to use for downsweep
}
mkModSummaryCache :: [(ModSummary, SummProvenance)] -> ModSummaryCacheMap
@@ -928,15 +916,28 @@ getRootSummary excl_mods summ_cache imports_cache hsc_env target
rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
dflags = homeUnitEnv_dflags (ue_findHomeUnitEnv uid (hsc_unit_env hsc_env))
--- | Execute 'getRootSummary' for the 'Target's using the parallelism pipeline system.
+-- | Execute 'getRootSummary' for the 'Target's in bundles, spawning one
+-- worker per bundle. The number of bundles processed at once is limited by
+-- the given 'Concurrency'.
rootSummariesParallel
- :: WorkerLimit -> MakeEnv -> [Target]
+ :: Concurrency -> HscEnv -> [Target]
-> (HscEnv -> Target -> IO (Either DriverMessages ModSummary))
-> IO ([DriverMessages], [ModSummary])
-rootSummariesParallel n_jobs make_env targets get_summary = do
- partitionEithers <$> mapConcDS n_jobs bundle_size make_env get_summary targets
- where
- bundle_size = 20
+rootSummariesParallel conc hsc_env targets get_summary = do
+ results <-
+ mapConcurrentWorkers "root_summary_worker" conc (viewHscWorkerEnv hsc_env)
+ ( \ work_env bundle ->
+ withConcurrency conc $
+ mapM (get_summary (setHscWorkerEnv work_env hsc_env)) bundle )
+ bundles
+ pure $ partitionEithers (concat results)
+ where
+ bundle_size = 20
+
+ bundles = mk_bundles targets
+ mk_bundles = unfoldr \case
+ [] -> Nothing
+ ts -> Just (splitAt bundle_size ts)
--------------------------------------------------------------------------------
-- * Check/validate properties and error out
@@ -1762,7 +1763,7 @@ data NodeRes v
-- node. The result includes the previously visited nodes given in @base_map@,
-- s.t. @parDfsBuild base_map [] _ _ == base_map@.
--
--- The @expand@ function returns an 'NResult'. See the 'NResult' documentation
+-- The @expand@ function returns a 'NodeRes'. See the 'NodeRes' documentation
-- for more information about each result type.
--
-- Example usage: @n@ is instanced to @DownsweepNode@, @k@ is @NodeKey@, and @v@ is @ModuleNodeEdge@.
@@ -1785,90 +1786,25 @@ parDfsBuild :: forall k v n. Ord k
-- ^ The result accumulates the payload of expanding the root nodes
-- and all nodes transitively reachable from those roots.
parDfsBuild base_map roots key expand = ReaderT $ \ds_env -> do
- exc_var <- newTVarIO $ Nothing @MC.SomeException
- visited_var <- newTVarIO $ fromMaybe Map.empty base_map
- pending <- newTVarIO $ Set.empty @k
- worklist <- newTQueueIO @n
- threads <- newTVarIO []
-
- coord_tid <- forkIO $
- coordinator ds_env exc_var visited_var worklist pending threads
- `MC.catch` \case
- (e::MC.SomeException)
- -- exit cleanly when killed
- | Just ThreadKilled <- fromException e -> return ()
- -- if the coordinator somehow else crashes,
- -- signal the exc_var for the main thread to throw it
- | otherwise -> atomically (modifyTVar' exc_var (<|> Just e))
-
- atomically $ mapM_ (writeTQueue worklist) roots
-
- mb_exc <- wait_done exc_var worklist pending
- `MC.finally` do
- killThread coord_tid
- mapM_ killThread =<< readTVarIO threads
-
- case mb_exc of
- Just e -> throwIO e
- Nothing -> readTVarIO visited_var
- where
- wait_done exc_var worklist pending =
- -- this txn retries until all work is done or an exception is signaled
- atomically $ do
- readTVar exc_var >>= \case
- Just e -> return (Just e)
- Nothing -> do
- empty_worklist <- isEmptyTQueue worklist
- empty_pending <- Set.null <$> readTVar pending
- check (empty_worklist && empty_pending)
- return Nothing
-
- coordinator ds_env exc_var visvar worklist pendvar threads = forever $ do
- mb_node_to_expand <- atomically $ do
- node <- readTQueue worklist
- let k = key node
-
- visited <- readTVar visvar
- pending <- readTVar pendvar
-
- if (k `Set.member` pending || k `Map.member` visited)
- then return Nothing
- else do
- -- must add to pending in the same transaction as worklist dequeue,
- -- otherwise the main thread may find both the worklist and pending
- -- lists empty and exit prematurely.
- modifyTVar' pendvar (Set.insert k)
- return (Just (k, node))
-
- case mb_node_to_expand of
- Nothing -> return ()
- Just (k, node) -> do
- tid <- MC.mask_ $ forkIOWithUnmask $ \unmask ->
- unmask (withLocalTmpFSMake (ds_make_env ds_env) $ \make_env ->
- worker ds_env{ds_make_env = make_env} visvar worklist pendvar k node)
- `MC.catch` \case
- e | Just (_ :: SomeAsyncException) <- fromException e
- -> throwIO e -- async exceptions like KillThread get thrown
- | otherwise -- exceptions in workers are written for main thread
- -> atomically (modifyTVar' exc_var (<|> Just e))
-
- atomically $ modifyTVar' threads (tid:)
-
- worker ds_env@DownsweepEnv{..} visvar worklist pendvar k node =
- withAbstractSem (compile_sem ds_make_env) $ do
- r <- runDownsweepM ds_env $
- expand node -- do the main work!
-
- atomically $ do
- case r of
- NSkip ->
- modifyTVar' visvar (Map.insert k NSkip)
- NSuccess (v,ns) -> do
- modifyTVar' visvar (Map.insert k (NSuccess v))
- mapM_ (writeTQueue worklist) ns
-
- modifyTVar' pendvar (Set.delete k)
+ let
+ conc :: Concurrency
+ conc = ds_concurrency ds_env
+
+ expand_node :: ConcurrentWorkerEnv -> n -> IO (NodeRes v, [n])
+ expand_node worker_env node = do
+ result <- withConcurrency conc $
+ runDownsweepM (setDownsweepWorkerEnv worker_env ds_env) (expand node)
+ pure $ case result of
+ NSkip -> (NSkip, [])
+ NSuccess (val, new_work) -> (NSuccess val, new_work)
+
+ concurrentTraversal_DF "downsweep_worker" conc (viewHscWorkerEnv $ ds_hsc_env ds_env)
+ (fromMaybe mempty base_map) roots key expand_node
+
+setDownsweepWorkerEnv :: ConcurrentWorkerEnv -> DownsweepEnv -> DownsweepEnv
+setDownsweepWorkerEnv work_env env =
+ env { ds_hsc_env = setHscWorkerEnv work_env (ds_hsc_env env) }
{-
Note [Downsweep Control Flow and Caching]
@@ -1963,70 +1899,10 @@ things, and that processing can often be costly (e.g. see `expandModuleSummary`)
We leverage multiple threads in this traversal to expand more than one module
at once, respecting -j<N> to mean we never expand more than N modules at once.
-The parallel downsweep is all handled by `parDfsBuild` as follows:
-
-- We launch a thread for every module we discover that needs to be
- expanded in the `coordinator` thread, popping it from the worklist
-- Every launched `worker` thread blocks waiting for a semaphore token
- (`withAbstractSem`) to respect -j<N>
-- The main thread waits until both the worklist and pending list is
- cleared, atomically.
-
-STM is used crucially to guarantee e.g. we don't have race conditions
-between taking from the worklist and writing to the pending list while
-checking whether they are clear.
-
-Exceptions are bubbled up to the main thread. The "main" thread, which is
-typically waiting for the worklist+pending lists to be clear, instead gets
-unblocked by this exception (signaled in `exc_var`) and re-throws it.
--}
---------------------------------------------------------------------------------
--- * Concurrent utilities
---------------------------------------------------------------------------------
-
--- | Map an action over a list using the parallelism pipeline system.
--- Create bundles of the list elems wrapped in a 'MakeAction' that uses
--- 'withAbstractSem' to wait for a free slot, limiting the number of
--- concurrently computed summaries to the value of the @-j@ option or the slots
--- allocated by the job server, if that is used.
---
--- The 'MakeAction' returns 'Maybe', which is not handled as an error, because
--- 'runLoop' only sets it to 'Nothing' when an exception was thrown, so the
--- result won't be read anyway here.
---
--- To emulate the current behavior, we funnel exceptions past the concurrency
--- barrier and rethrow the first one afterwards.
-mapConcDS ::
- WorkerLimit ->
- Int {-^ Batch size -} ->
- MakeEnv ->
- (HscEnv -> a -> IO b) ->
- [a] ->
- IO ([b])
-mapConcDS n_jobs bundle_size make_env run_action xs = do
- (actions, get_results) <- unzip <$> mapM action_and_result (zip [1..] bundles)
- runAllPipelines n_jobs make_env actions
- (sequence . catMaybes <$> sequence get_results) >>= \case
- Right results -> pure (concat results)
- Left exc -> throwIO exc
- where
- bundles = mk_bundles xs
-
- mk_bundles = unfoldr \case
- [] -> Nothing
- ts -> Just (splitAt bundle_size ts)
-
- action_and_result (log_queue_id, ts) = do
- res_var <- liftIO newEmptyMVar
- pure $! (MakeAction (action log_queue_id ts) res_var, readMVar res_var)
-
- action log_queue_id target_bundle = do
- env@MakeEnv {compile_sem} <- ask
- lift $ lift $
- withAbstractSem compile_sem $
- withLoggerHsc log_queue_id env \ lcl_hsc_env ->
- MC.try (mapM (run_action lcl_hsc_env) target_bundle) >>= \case
- Left e | Just (_ :: SomeAsyncException) <- fromException e ->
- throwIO e
- a -> pure a
+We use the concurrent scheduling abstraction from GHC.Driver.Concurrency
+('concurrentTraversal_DF'). Each time we discover a new node, a worker is
+spawned to expand it. After each expansion completes, the resulting children
+nodes are pushed onto the worklist. With -j1 no threads are involved: each
+expansion runs in sequence.
+-}
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -63,8 +63,9 @@ import GHC.Driver.Env
import GHC.Driver.Errors
import GHC.Driver.Errors.Types
import GHC.Driver.Main
-import GHC.Driver.MakeSem
import GHC.Driver.Downsweep
+import GHC.Driver.Concurrency
+import GHC.Driver.Config.Concurrency
import GHC.Driver.MakeAction
import GHC.Types.UnresolvedImport
@@ -156,22 +157,20 @@ depanal :: GhcMonad m =>
depanal excluded_mods allow_dup_roots = do
hsc_env <- getSession
let sec = initSourceErrorContext (hsc_dflags hsc_env)
- (errs, mod_graph) <- depanalE mkUnknownDiagnostic Nothing excluded_mods allow_dup_roots
+ (errs, mod_graph) <- depanalE excluded_mods allow_dup_roots
if isEmptyMessages errs
then pure mod_graph
else throwErrors sec (fmap GhcDriverMessage errs)
-- | Perform dependency analysis like in 'depanal'.
-- In case of errors, the errors and an empty module graph are returned.
-depanalE :: GhcMonad m => -- New for #17459
- (GhcMessage -> AnyGhcDiagnostic)
- -> Maybe Messager
- -> [ModuleName] -- ^ excluded modules
+depanalE :: GhcMonad m =>
+ [ModuleName] -- ^ excluded modules
-> Bool -- ^ allow duplicate roots
-> m (DriverMessages, ModuleGraph)
-depanalE diag_wrapper msg excluded_mods allow_dup_roots = do
+depanalE excluded_mods allow_dup_roots = do
hsc_env <- getSession
- (errs, mod_graph) <- depanalPartial diag_wrapper msg excluded_mods allow_dup_roots
+ (errs, mod_graph) <- depanalPartial excluded_mods allow_dup_roots
if isEmptyMessages errs
then do
hsc_env <- getSession
@@ -209,13 +208,11 @@ depanalE diag_wrapper msg excluded_mods allow_dup_roots = do
-- new module graph.
depanalPartial
:: GhcMonad m
- => (GhcMessage -> AnyGhcDiagnostic)
- -> Maybe Messager
- -> [ModuleName] -- ^ excluded modules
+ => [ModuleName] -- ^ excluded modules
-> Bool -- ^ allow duplicate roots
-> m (DriverMessages, ModuleGraph)
-- ^ possibly empty 'Bag' of errors and a module graph.
-depanalPartial diag_wrapper msg excluded_mods allow_dup_roots = do
+depanalPartial excluded_mods allow_dup_roots = do
hsc_env <- getSession
let
targets = hsc_targets hsc_env
@@ -234,7 +231,7 @@ depanalPartial diag_wrapper msg excluded_mods allow_dup_roots = do
liftIO $ flushFinderCaches (hsc_FC hsc_env) (hsc_unit_env hsc_env)
(errs, mod_graph) <- liftIO $ downsweep
- hsc_env diag_wrapper msg (mgModSummaries old_graph) Nothing
+ hsc_env (mgModSummaries old_graph) Nothing
excluded_mods allow_dup_roots
return (unionManyMessages errs, mod_graph)
@@ -438,7 +435,7 @@ loadWithCache :: GhcMonad m => Maybe ModIfaceCache -- ^ Instructions about how t
-> m SuccessFlag
loadWithCache cache diag_wrapper how_much = do
msg <- mkBatchMsg <$> getSession
- (errs, mod_graph) <- depanalE diag_wrapper (Just msg) [] False -- #17459
+ (errs, mod_graph) <- depanalE [] False -- #17459
success <- load' cache how_much diag_wrapper (Just msg) mod_graph
hsc_env <- getSession
let sec = initSourceErrorContext (hsc_dflags hsc_env)
@@ -840,14 +837,15 @@ The Algorithm
a pair of an `IO a` action and a `MVar a`, where to place the result.
The list is sorted topologically, so can be executed in order without fear of
blocking.
-* runPipelines takes this list and eventually passes it to runLoop which executes
- each action and places the result into the right MVar.
-* The amount of parallelism is controlled by a semaphore. This is just used around the
- module compilation step, so that only the right number of modules are compiled at
- the same time which reduces overall memory usage and allocations.
-* Each proper node has a LogQueue, which dictates where to send it's output.
-* The LogQueue is placed into the LogQueueQueue when the action starts and a worker
- thread processes the LogQueueQueue printing logs for each module in a stable order.
+* runPipelines spawns one worker per action ('GHC.Driver.Concurrency.mapConcurrentWorkers'),
+ which executes the action and places the result into the right MVar.
+* The amount of parallelism is controlled by a semaphore ('withMakeEnvConcurrency'). This is
+ just used around the module compilation step, so that only the right number of
+ modules are compiled at the same time which reduces overall memory usage and
+ allocations.
+* Each worker has a LogQueue, which dictates where to send its output. A log
+ thread processes the LogQueues, printing logs for each module in a stable
+ order (the order in which the actions were spawned).
* The result variable for an action producing `a` is of type `Maybe a`, therefore
it is still filled on a failure. If a module fails to compile, the
failure is propagated through the whole module graph and any modules which didn't
@@ -1137,7 +1135,7 @@ interpretBuildPlan hug mhmi_cache old_hpt plan = do
!build_deps = getDependencies (map gwib_mod deps) build_map
let loop_action = withCurrentUnit loop_unit $ do
!_ <- wait_deps build_deps
- hsc_env <- asks hsc_env
+ hsc_env <- asks me_hsc_env
let mns :: [ModuleName]
mns = mapMaybe (nodeKeyModName . gwib_mod) deps
@@ -1180,7 +1178,7 @@ interpretBuildPlan hug mhmi_cache old_hpt plan = do
withCurrentUnit :: UnitId -> RunMakeM a -> RunMakeM a
withCurrentUnit uid = do
- local (\env -> env { hsc_env = hscSetActiveUnitId uid (hsc_env env)})
+ local (\env -> env { me_hsc_env = hscSetActiveUnitId uid (me_hsc_env env)})
upsweep
:: WorkerLimit -- ^ The number of workers we wish to run in parallel
@@ -1556,10 +1554,11 @@ executeInstantiationNode k n deps uid iu = do
env <- ask
-- Output of the logger is mediated by a central worker to
-- avoid output interleaving
- msg <- asks env_messager
- wrapper <- asks diag_wrapper
- lift $ MaybeT $ withLoggerHsc k env $ \hsc_env ->
- let lcl_hsc_env = setHUG deps hsc_env
+ msg <- asks me_messager
+ wrapper <- asks me_diag_wrapper
+ lift $ MaybeT $
+ let hsc_env = me_hsc_env env
+ lcl_hsc_env = setHUG deps hsc_env
in wrapAction wrapper lcl_hsc_env $ do
res <- upsweep_inst lcl_hsc_env msg k n uid iu
cleanCurrentModuleTempFilesMaybe (hsc_logger hsc_env) (hsc_tmpfs hsc_env) (hsc_dflags hsc_env)
@@ -1582,13 +1581,13 @@ executeCompileNode :: Int
-> ModuleNodeInfo
-> RunMakeM HomeModInfo
executeCompileNode k n !old_hmi hug mrehydrate_mods mni = do
- me@MakeEnv{..} <- ask
+ make_env <- ask
-- Rehydrate any dependencies if this module had a boot file or is a signature file.
- lift $ MaybeT (withAbstractSem compile_sem $ withLoggerHsc k me $ \hsc_env -> do
+ lift $ MaybeT (withMakeEnvConcurrency make_env $ \hsc_env -> do
hsc_env' <- liftIO $ maybeRehydrateBefore (setHUG hug hsc_env) mni fixed_mrehydrate_mods
case mni of
- ModuleNodeCompile mod -> executeCompileNodeWithSource hsc_env' me mod
- ModuleNodeFixed key loc -> executeCompileNodeFixed hsc_env' me key loc
+ ModuleNodeCompile mod -> executeCompileNodeWithSource hsc_env' make_env mod
+ ModuleNodeFixed key loc -> executeCompileNodeFixed hsc_env' make_env key loc
)
where
@@ -1601,9 +1600,9 @@ executeCompileNode k n !old_hmi hug mrehydrate_mods mni = do
_ -> mrehydrate_mods
executeCompileNodeFixed :: HscEnv -> MakeEnv -> ModNodeKeyWithUid -> ModLocation -> IO (Maybe HomeModInfo)
- executeCompileNodeFixed hsc_env MakeEnv{diag_wrapper, env_messager} mod loc =
- wrapAction diag_wrapper hsc_env $ do
- forM_ env_messager $ \hscMessage -> hscMessage hsc_env (k, n) UpToDate (ModuleNode [] (ModuleNodeFixed mod loc))
+ executeCompileNodeFixed hsc_env MakeEnv{me_diag_wrapper, me_messager} mod loc =
+ wrapAction me_diag_wrapper hsc_env $ do
+ forM_ me_messager $ \hscMessage -> hscMessage hsc_env (k, n) UpToDate (ModuleNode [] (ModuleNodeFixed mod loc))
read_result <- readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule mod) (ml_hi_file loc)
let sec = initSourceErrorContext (hsc_dflags hsc_env)
case read_result of
@@ -1619,7 +1618,7 @@ executeCompileNode k n !old_hmi hug mrehydrate_mods mni = do
return (HomeModInfo iface details hm_linkable)
executeCompileNodeWithSource :: HscEnv -> MakeEnv -> ModSummary -> IO (Maybe HomeModInfo)
- executeCompileNodeWithSource hsc_env MakeEnv{diag_wrapper, env_messager} mod = do
+ executeCompileNodeWithSource hsc_env MakeEnv{me_diag_wrapper, me_messager} mod = do
let -- Use the cached DynFlags which includes OPTIONS_GHC pragmas
lcl_dynflags = ms_hspp_opts mod
let lcl_hsc_env =
@@ -1628,8 +1627,8 @@ executeCompileNode k n !old_hmi hug mrehydrate_mods mni = do
hsc_env
-- Compile the module, locking with a semaphore to avoid too many modules
-- being compiled at the same time leading to high memory usage.
- wrapAction diag_wrapper lcl_hsc_env $ do
- res <- upsweep_mod lcl_hsc_env env_messager old_hmi mod k n
+ wrapAction me_diag_wrapper lcl_hsc_env $ do
+ res <- upsweep_mod lcl_hsc_env me_messager old_hmi mod k n
cleanCurrentModuleTempFilesMaybe (hsc_logger hsc_env) (hsc_tmpfs hsc_env) lcl_dynflags
return res
@@ -1853,15 +1852,15 @@ Also closely related are
-}
executeLinkNode :: HomeUnitGraph -> (Int, Int) -> UnitId -> [NodeKey] -> RunMakeM ()
-executeLinkNode hug kn@(k, _) uid deps = do
+executeLinkNode hug kn uid deps = do
withCurrentUnit uid $ do
make_env@MakeEnv{..} <- ask
- let dflags = hsc_dflags hsc_env
- msg' = (\messager -> \recomp -> messager hsc_env kn recomp (LinkNode deps uid)) <$> env_messager
+ let dflags = hsc_dflags me_hsc_env
+ msg' = (\messager -> \recomp -> messager me_hsc_env kn recomp (LinkNode deps uid)) <$> me_messager
- linkresult <- lift $ MaybeT $ withAbstractSem compile_sem $ withLoggerHsc k make_env $ \lcl_hsc_env -> do
+ linkresult <- lift $ MaybeT $ withMakeEnvConcurrency make_env $ \lcl_hsc_env -> do
let hsc_env' = setHUG hug lcl_hsc_env
- wrapAction diag_wrapper hsc_env' $ do
+ wrapAction me_diag_wrapper hsc_env' $ do
link (ghcLink dflags)
hsc_env'
True -- We already decided to link
=====================================
compiler/GHC/Driver/MakeAction.hs
=====================================
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
module GHC.Driver.MakeAction
( MakeAction(..)
, RunMakeM
@@ -7,79 +6,41 @@ module GHC.Driver.MakeAction
-- * Running the pipelines
, runAllPipelines
, runPipelines
- -- * Worker limit
- , WorkerLimit(..)
- , mkWorkerLimit
- , runWorkerLimit
-- * Utility
- , withLoggerHsc
- , withParLog
- , withLocalTmpFS
- , withLocalTmpFSMake
+ , withMakeEnvConcurrency
+ , withWorkerLimitHsc
+ , viewHscWorkerEnv
+ , setHscWorkerEnv
) where
import GHC.Prelude
-import GHC.Driver.DynFlags
-import GHC.Driver.Monad
+import GHC.Driver.Concurrency
+import GHC.Driver.Config.Concurrency
import GHC.Driver.Env
import GHC.Driver.Errors.Types
import GHC.Driver.Messager
-import GHC.Driver.MakeSem
-
-#if defined(wasm32_HOST_ARCH) || defined(javascript_HOST_ARCH)
-import System.Semaphore
- ( SemaphoreIdentifier )
-#else
-import System.Semaphore
- ( SemaphoreError, SemaphoreIdentifier )
-#endif
-
-#if !(defined(wasm32_HOST_ARCH) || defined(javascript_HOST_ARCH))
-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 )
-#endif
-import GHC.Utils.Logger
-import GHC.Utils.TmpFs
+import GHC.Driver.Monad
-#if defined(wasm32_HOST_ARCH) || defined(javascript_HOST_ARCH)
-import Control.Concurrent ( ThreadId, killThread, forkIOWithUnmask )
-#else
-import Control.Concurrent ( newQSem, waitQSem, signalQSem, ThreadId, killThread, forkIOWithUnmask )
-#endif
import qualified GHC.Conc as CC
import Control.Concurrent.MVar
import Control.Monad
import qualified Control.Monad.Catch as MC
-
-#if defined(wasm32_HOST_ARCH) || defined(javascript_HOST_ARCH)
-import GHC.Conc ( getNumProcessors )
-#else
-import GHC.Conc ( getNumProcessors, getNumCapabilities, setNumCapabilities )
-#endif
-import Control.Monad.Trans.Reader
-import GHC.Driver.Pipeline.LogQueue
-import Control.Concurrent.STM
import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.Reader
--------------------------------------------------------------------------------
-- * MakeEnv and MakeAction
--------------------------------------------------------------------------------
-- | Environment used when compiling a module
-data MakeEnv = MakeEnv { hsc_env :: !HscEnv -- The basic HscEnv which will be augmented for each module
- , compile_sem :: !AbstractSem
- -- Modify the environment for module k, with the supplied logger modification function.
- -- For -j1, this wrapper doesn't do anything
- -- For -jn, the wrapper initialised a log queue and then modifies the logger to pipe its output
- -- into the log queue.
- , withLogger :: forall a . Int -> ((Logger -> Logger) -> IO a) -> IO a
- , env_messager :: !(Maybe Messager)
- , diag_wrapper :: GhcMessage -> AnyGhcDiagnostic
- }
+data MakeEnv =
+ MakeEnv
+ { me_hsc_env :: !HscEnv -- The basic HscEnv which will be augmented for each module
+ , me_concurrency :: !Concurrency
+ , me_messager :: !(Maybe Messager)
+ , me_diag_wrapper :: GhcMessage -> AnyGhcDiagnostic
+ }
-- | Come up with a 'MakeEnv' based on the given 'WorkerLimit'.
-- For -j1, it will be a trivial 'MakeEnv' not prepared for parallelism.
@@ -91,47 +52,14 @@ withMakeEnv
-> Maybe Messager -- ^ Optional custom messager to use to report progress
-> (MakeEnv -> IO r) -> IO r
withMakeEnv worker_limit hsc_env diag_wrapper mHscMessager act =
- if isWorkerLimitSequential worker_limit
- then withSeqMakeEnv
- else withParMakeEnv
- where
- withSeqMakeEnv = do
- let seq_env = MakeEnv
- { hsc_env = hsc_env
- , withLogger = \_ k -> k id
- , compile_sem = AbstractSem (return ()) (return ())
- , env_messager = mHscMessager
- , diag_wrapper = diag_wrapper
- }
- act seq_env
-
- withParMakeEnv = do
- -- A variable which we write to when an error has happened and we have to tell the
- -- logging thread to gracefully shut down.
- stopped_var <- newTVarIO False
- -- The queue of LogQueues which actions are able to write to. When an action starts it
- -- will add it's LogQueue into this queue.
- log_queue_queue_var <- newTVarIO newLogQueueQueue
- -- Thread which coordinates the printing of logs
- wait_log_thread <- logThread (hsc_logger hsc_env) stopped_var log_queue_queue_var
-
-
- -- Make the logger thread-safe, in case there is some output which isn't sent via the LogQueue.
- thread_safe_logger <- liftIO $ makeThreadSafe (hsc_logger hsc_env)
- let thread_safe_hsc_env = hsc_env { hsc_logger = thread_safe_logger }
-
- runWorkerLimit (hsc_logger hsc_env) (hsc_dflags 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
- , env_messager = mHscMessager
- , diag_wrapper = diag_wrapper
- }
- -- Reset the number of capabilities once the upsweep ends.
- r <- act env
- atomically $ writeTVar stopped_var True
- wait_log_thread
- pure r
+ withWorkerLimitHsc hsc_env worker_limit $ \ conc hsc_env' ->
+ act $
+ MakeEnv
+ { me_hsc_env = hsc_env'
+ , me_concurrency = conc
+ , me_messager = mHscMessager
+ , me_diag_wrapper = diag_wrapper
+ }
-- ** MakeAction ---------------------------------------------------------------
@@ -139,9 +67,6 @@ data MakeAction = forall a . MakeAction !(RunMakeM a) !(MVar (Maybe a))
type RunMakeM a = ReaderT MakeEnv (MaybeT IO) a
-waitMakeAction :: MakeAction -> IO ()
-waitMakeAction (MakeAction _ mvar) = () <$ readMVar mvar
-
--------------------------------------------------------------------------------
-- * Running the pipelines
--------------------------------------------------------------------------------
@@ -155,149 +80,51 @@ runPipelines
runPipelines n_job hsc_env diag_wrapper mHscMessager all_pipelines = do
liftIO $ label_self "main --make thread"
withMakeEnv n_job hsc_env diag_wrapper mHscMessager $ \make_env -> do
- runAllPipelines n_job make_env all_pipelines
+ runAllPipelines make_env all_pipelines
where
label_self :: String -> IO ()
label_self thread_name = do
self_tid <- CC.myThreadId
CC.labelThread self_tid thread_name
--- | Run the given actions and then wait for them all to finish.
-runAllPipelines :: WorkerLimit -> MakeEnv -> [MakeAction] -> IO ()
-runAllPipelines worker_limit env acts = do
- let single_worker = isWorkerLimitSequential worker_limit
- spawn_actions :: IO [ThreadId]
- spawn_actions = if single_worker
- then (:[]) <$> (forkIOWithUnmask $ \unmask -> void $ runLoop (\io -> io unmask) env acts)
- else runLoop forkIOWithUnmask env acts
-
- kill_actions :: [ThreadId] -> IO ()
- kill_actions tids = mapM_ killThread tids
-
- MC.bracket spawn_actions kill_actions $ \_ -> do
- mapM_ waitMakeAction acts
-
--- | Execute each action in order, limiting the amount of parallelism by the given
--- semaphore.
-runLoop :: (((forall a. IO a -> IO a) -> IO ()) -> IO a) -> MakeEnv -> [MakeAction] -> IO [a]
-runLoop _ _env [] = return []
-runLoop fork_thread env (MakeAction act res_var :acts) = do
-
- -- withLocalTmpFs has to occur outside of fork to remain deterministic
- new_thread <- withLocalTmpFSMake env $ \lcl_env ->
- MC.mask_ $
- fork_thread $ \unmask -> (do
- mres <- (unmask $ run_pipeline lcl_env act)
- `MC.onException` (putMVar res_var Nothing) -- Defensive: If there's an unhandled exception then still signal the failure.
- putMVar res_var mres)
- threads <- runLoop fork_thread env acts
- return (new_thread : threads)
- where
- run_pipeline :: MakeEnv -> RunMakeM a -> IO (Maybe a)
- run_pipeline env p = runMaybeT (runReaderT p env)
-
---------------------------------------------------------------------------------
--- * Worker Limit
---------------------------------------------------------------------------------
-
--- | This describes what we use to limit the number of jobs, either we limit it
--- ourselves to a specific number or we have an external parallelism semaphore
--- limit it for us.
-data WorkerLimit
- = NumProcessorsLimit Int
- | JSemLimit
- SemaphoreIdentifier
- -- ^ Semaphore identifier from @-jsem@
- deriving Eq
-
-mkWorkerLimit :: DynFlags -> IO WorkerLimit
-mkWorkerLimit dflags =
- case parMakeCount dflags of
- Nothing -> pure $ num_procs 1
- Just (ParMakeSemaphore h) -> pure (JSemLimit h)
- Just ParMakeNumProcessors -> num_procs <$> getNumProcessors
- Just (ParMakeThisMany n) -> pure $ num_procs n
- where
- num_procs x = NumProcessorsLimit (max 1 x)
-
-isWorkerLimitSequential :: WorkerLimit -> Bool
-isWorkerLimitSequential (NumProcessorsLimit x) = x <= 1
-isWorkerLimitSequential (JSemLimit {}) = False
-
-runWorkerLimit :: Logger -> DynFlags -> WorkerLimit -> (AbstractSem -> IO a) -> IO a
-#if defined(wasm32_HOST_ARCH) || defined(javascript_HOST_ARCH)
-runWorkerLimit _logger _dflags _ action = do
- lock <- newMVar ()
- action $ AbstractSem (takeMVar lock) (putMVar lock ())
-#else
-runWorkerLimit logger dflags worker_limit action = case worker_limit of
- NumProcessorsLimit n_jobs ->
- runNjobsAbstractSem n_jobs 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 (checkBuildingCabalPackage dflags) err
- msg = singleMessage $ mkPlainMsgEnvelope (initDiagOpts dflags) noSrcSpan diag
- printOrThrowDiagnostics logger (initPrintConfig dflags) (initDiagOpts dflags) (GhcDriverMessage <$> msg)
- runNjobsAbstractSem 1 action
-#endif
-
-#if !(defined(wasm32_HOST_ARCH) || defined(javascript_HOST_ARCH))
-runNjobsAbstractSem :: Int -> (AbstractSem -> IO a) -> IO a
-runNjobsAbstractSem n_jobs action = do
- compile_sem <- newQSem n_jobs
- n_capabilities <- getNumCapabilities
- n_cpus <- getNumProcessors
- let
- asem = AbstractSem (waitQSem compile_sem) (signalQSem compile_sem)
- set_num_caps n = unless (n_capabilities /= 1) $ setNumCapabilities n
- updNumCapabilities = do
- -- Setting number of capabilities more than
- -- CPU count usually leads to high userspace
- -- lock contention. #9221
- set_num_caps $ min n_jobs n_cpus
- resetNumCapabilities = set_num_caps n_capabilities
- MC.bracket_ updNumCapabilities resetNumCapabilities $ action asem
-
-#endif
+-- | Run the given actions (assumed to be in dependency order) and wait for
+-- them all to finish, rethrowing the first unhandled exception (in action order)
+-- afterwards.
+runAllPipelines :: MakeEnv -> [MakeAction] -> IO ()
+runAllPipelines env acts =
+ void $
+ mapConcurrentWorkers "make_worker" (me_concurrency env) (viewHscWorkerEnv (me_hsc_env env))
+ ( \ work_env (MakeAction act res_var) -> do
+ let lcl_env = env { me_hsc_env = setHscWorkerEnv work_env (me_hsc_env env) }
+ mres <- runMaybeT (runReaderT act lcl_env)
+ `MC.onException` putMVar res_var Nothing
+ putMVar res_var mres )
+ acts
--------------------------------------------------------------------------------
-- * Utility
--------------------------------------------------------------------------------
-withLoggerHsc :: Int -> MakeEnv -> (HscEnv -> IO a) -> IO a
-withLoggerHsc k MakeEnv{withLogger, hsc_env} cont = do
- withLogger k $ \modifyLogger -> do
- let lcl_logger = modifyLogger (hsc_logger hsc_env)
- hsc_env' = hsc_env { hsc_logger = lcl_logger }
- -- Run continuation with modified logger
- cont hsc_env'
-
-withParLog :: TVar LogQueueQueue -> Int -> ((Logger -> Logger) -> IO b) -> IO b
-withParLog lqq_var k cont = do
- let init_log = do
- -- Make a new log queue
- lq <- newLogQueue k
- -- Add it into the LogQueueQueue
- atomically $ initLogQueue lqq_var lq
- return lq
- finish_log lq = liftIO (finishLogQueue lq)
- MC.bracket init_log finish_log $ \lq -> cont (pushLogHook (const (parLogAction lq)))
-
-withLocalTmpFS :: TmpFs -> (TmpFs -> IO a) -> IO a
-withLocalTmpFS tmpfs act = do
- let initialiser = do
- liftIO $ forkTmpFsFrom tmpfs
- finaliser tmpfs_local = do
- liftIO $ mergeTmpFsInto tmpfs_local tmpfs
- -- Add remaining files which weren't cleaned up into local tmp fs for
- -- clean-up later.
- -- Clear the logQueue if this node had it's own log queue
- MC.bracket initialiser finaliser act
-
-withLocalTmpFSMake :: MakeEnv -> (MakeEnv -> IO a) -> IO a
-withLocalTmpFSMake env k =
- withLocalTmpFS (hsc_tmpfs (hsc_env env)) $ \lcl_tmpfs
- -> k (env { hsc_env = (hsc_env env) { hsc_tmpfs = lcl_tmpfs }})
+-- | A version of 'withWorkerLimit' taking an 'HscEnv'.
+withWorkerLimitHsc :: HscEnv -> WorkerLimit -> (Concurrency -> HscEnv -> IO a) -> IO a
+withWorkerLimitHsc hsc_env limit k =
+ withWorkerLimit (hsc_logger hsc_env) (hsc_tmpfs hsc_env)
+ (semaphoreOpenFailureHandler (hsc_logger hsc_env) (hsc_dflags hsc_env))
+ limit
+ (\conc work_env -> k conc (setHscWorkerEnv work_env hsc_env))
+
+-- | Like 'withConcurrency', but retrieving the 'Concurrency' and 'HscEnv' from
+-- the 'MakeEnv'.
+withMakeEnvConcurrency :: MakeEnv -> (HscEnv -> IO a) -> IO a
+withMakeEnvConcurrency env cont =
+ withConcurrency (me_concurrency env) (cont (me_hsc_env env))
+
+-- | The local environment for a concurrent worker derived from an 'HscEnv'.
+viewHscWorkerEnv :: HscEnv -> ConcurrentWorkerEnv
+viewHscWorkerEnv hsc_env =
+ ConcurrentWorkerEnv { cwe_logger = hsc_logger hsc_env, cwe_tmpfs = hsc_tmpfs hsc_env }
+
+-- | Set the local concurrent worker environment within an 'HscEnv'.
+setHscWorkerEnv :: ConcurrentWorkerEnv -> HscEnv -> HscEnv
+setHscWorkerEnv (ConcurrentWorkerEnv { cwe_logger = logger, cwe_tmpfs = tmpfs }) hsc_env =
+ hsc_env { hsc_logger = logger, hsc_tmpfs = tmpfs }
=====================================
compiler/GHC/Driver/MakeSem.hs
=====================================
@@ -39,6 +39,7 @@ import GHC.Utils.Json
import System.Semaphore
( AbstractSem(..)
, ClientSemaphore
+ , SemaphoreError
, SemaphoreIdentifier
, SemaphoreToken
, openSemaphore
@@ -534,18 +535,24 @@ makeJobserver sem_ident = do
-- | Implement an abstract semaphore using a semaphore 'Jobserver'
-- which queries the system semaphore of the given name for resources.
+--
+-- Returns 'Left' if the system semaphore could not be opened, in which case
+-- the operation is not run at all. A 'SemaphoreError' arising after the
+-- semaphore was successfully opened is thrown, not returned.
runJSemAbstractSem :: SemaphoreIdentifier -- ^ the semaphore identifier (from @-jsem@)
-> (AbstractSem -> IO a) -- ^ the operation to run
-- which requires a semaphore
- -> IO a
+ -> IO (Either SemaphoreError a)
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
- (_ :: Either MC.SomeException ()) <- MC.try cleanup
- MC.throwM e1
- Right x -> cleanup $> x
+ MC.try @_ @SemaphoreError (makeJobserver sem_ident) >>= \case
+ Left open_failure -> return (Left open_failure)
+ Right (abs, cleanup) -> do
+ r <- try $ unmask $ action abs
+ case r of
+ Left (e1 :: MC.SomeException) -> do
+ (_ :: Either MC.SomeException ()) <- MC.try cleanup
+ MC.throwM e1
+ Right x -> cleanup $> Right x
{- Note [Architecture of the Job Server]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Utils/TmpFs.hs
=====================================
@@ -6,6 +6,7 @@ module GHC.Utils.TmpFs
, initTmpFs
, forkTmpFsFrom
, mergeTmpFsInto
+ , withLocalTmpFS
, PathsToClean(..)
, emptyPathsToClean
, TempFileLifetime(..)
@@ -157,6 +158,16 @@ mergeTmpFsInto src dst = do
atomicModifyIORef' (tmp_files_to_clean dst) (\s -> (mergePathsToClean src_files s, ()))
atomicModifyIORef' (tmp_subdirs_to_clean dst) (\s -> (mergePathsToClean src_subdirs s, ()))
+-- | Run an action with a local 'TmpFs' forked from the given 'TmpFs'.
+--
+-- The remaining files of the local 'TmpFs' which weren't cleaned up by the
+-- action are merged back into the given 'TmpFs', for clean-up later.
+withLocalTmpFS :: TmpFs -> (TmpFs -> IO a) -> IO a
+withLocalTmpFS tmpfs act =
+ Exception.bracket
+ (forkTmpFsFrom tmpfs)
+ (\tmpfs_local -> mergeTmpFsInto tmpfs_local tmpfs)
+ act
cleanTempDirs :: Logger -> TmpFs -> IO ()
cleanTempDirs logger tmpfs
=====================================
compiler/ghc.cabal.in
=====================================
@@ -487,11 +487,13 @@ Library
GHC.Driver.ByteCode
GHC.Driver.CmdLine
GHC.Driver.CodeOutput
+ GHC.Driver.Concurrency
GHC.Driver.Config
GHC.Driver.Config.Cmm
GHC.Driver.Config.Cmm.Parser
GHC.Driver.Config.CmmToAsm
GHC.Driver.Config.CmmToLlvm
+ GHC.Driver.Config.Concurrency
GHC.Driver.Config.Core.Lint
GHC.Driver.Config.Core.Lint.Interactive
GHC.Driver.Config.Core.Opt.Arity
=====================================
utils/haddock/haddock-api/src/Haddock/Interface.hs
=====================================
@@ -172,7 +172,7 @@ createIfaces verbosity modules flags instIfaceMap = do
_ <- setSessionDynFlags dflags''
targets <- mapM (\(filePath, _) -> guessTarget filePath Nothing Nothing) hs_srcs
setTargets targets
- (_errs, modGraph) <- depanalE mkUnknownDiagnostic (Just batchMsg) [] False
+ (_errs, modGraph) <- depanalE [] False
-- Create (if necessary) and load .hi-files. With --no-compilation this happens later.
when (Flag_NoCompilation `notElem` flags) $ do
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/566d789d5522489eb017e9999f0b7bd…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/566d789d5522489eb017e9999f0b7bd…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: loopImports: Don't dup ms_uid in summary imports
by Marge Bot (＠marge-bot) 14 Aug '26
by Marge Bot (＠marge-bot) 14 Aug '26
14 Aug '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
15faa2de by Rodrigo Mesquita at 2026-08-14T17:22:05-04:00
loopImports: Don't dup ms_uid in summary imports
We were writing the ms_unitid of the mod summary with every single
import of that module
That complicated the code (as though the UnitId in that list could ever
be something else) and also allocates unnecessarily per every mod
import. Very slight allocation decrease measured locally in a few tests:
(MultiComponentModulesRecomp: -0.06%; MultiComponentModulesRecomp100: -0.05%)
Purely a clean up.
- - - - -
5207a07f by Rodrigo Mesquita at 2026-08-14T17:22:05-04:00
downsweep: make control flow simpler and cache correct
This refactor extracts the control flow of downsweep into a single
function `dfsBuild`, which takes care of iteratively expanding and
traversing all nodes of the in-construction module graph necessary to
build a full `ModuleGraph`.
There are three levels of caching going on, all of which are necessary
to make sure we don't do repeated work (notably, NEVER summarise the
same module twice).
1. `dfsBuild` accumulates the final module graph and never revisits the
same node of the module graph. Cache is keyed by the final
`ModuleGraph`s `NodeKey`s.
2. For Module A in home-unit u1, each import in the list of imports
needs to be *found* (call to `findImportedModuleWithIsBoot`): at this
point, we only have the `ModuleName` of the import, not the `Module`.
This *finding* is somewhat expensive, so we cache it as well
(`ImportsCache`). The cache key is the home-unit to which the module
belongs~[1], the import package qualifier, and the ModuleName.
[1] Different home-units will have different package flags, which means
potentially different `Module` resolution for the same `ModuleName`.
3. The most expensive operation we want to avoid is summarising a
`Module` into a `ModSummary`, which notably involves parsing the
module header from scratch.
The third cache, in essence, maps a `Module` to its `ModSummary`
(named `ModSummaryCache`). This cache upholds the invariant: we NEVER
summarise the same module twice. In practice, the cache key is the
Module's UnitId and the Source path; the reason is we need to
distinguish between `.hs` and `.hs-boot` files, as their summaries
will differ.
Note that (2) can't guarantee this alone: Two ModuleName imports in
separate units can (and likely do) map to the same `Module`.
Note that the previous implementation failed to achieve the
no-duplicate-work summarisation invariant, and we ended up doing a
quadratic amount of processing in scenarios like test
`MultiComponentModules100`.
See also Note [Downsweep Control Flow and Caching]
Fixes #27461
Perf changes:
MultiComponentModules(normal) ghc/alloc 2,097,389,264 1,992,186,736 -5.0% GOOD
MultiComponentModules100(normal) ghc/alloc 24,310,173,770 21,293,867,360 -12.4% GOOD
MultiComponentModulesRecomp(normal) ghc/alloc 602,761,394 498,543,984 -17.3% GOOD
MultiComponentModulesRecomp100(normal) ghc/alloc 11,885,968,240 8,895,404,864 -25.2% GOOD
-------------------------
Metric Decrease:
MultiComponentModules
MultiComponentModules100
MultiComponentModulesRecomp
MultiComponentModulesRecomp100
-------------------------
- - - - -
d82a6733 by Rodrigo Mesquita at 2026-08-14T17:22:05-04:00
implicitRequirementsShallow can never reach HoleUnit
findImportedModule will never return `HoleUnit` for a `ModuleName`
(a `HoleUnit` can only be found as a signature instantiation, never as a
directly *imported* thing)
Therefore, we can drop `[ModuleName]` returned by
`implicitRequirementsShallow`, which makes many things dead code.
Namely, the call to `implicitRequirementsShallow` from
GHC.Driver.Downsweep which was a performance bottleneck (for doing lots
of duplicate work in findImportedModule) is now entirely gone.
Fixes #27053
In an MR with this patch and the downsweep refactor (previous commit), CI says:
MultiComponentModules(normal) ghc/alloc 2,097,396,728 1,943,662,304 -7.3% GOOD
MultiComponentModules100(normal) ghc/alloc 24,310,182,136 17,227,574,440 -29.1% GOOD
MultiComponentModulesRecomp(normal) ghc/alloc 602,769,518 449,973,656 -25.3% GOOD
MultiComponentModulesRecomp100(normal) ghc/alloc 11,885,976,408 4,828,894,160 -59.4% GOOD
-------------------------
Metric Decrease:
MultiComponentModules
MultiComponentModules100
MultiComponentModulesRecomp
MultiComponentModulesRecomp100
-------------------------
- - - - -
ccd7d978 by Rodrigo Mesquita at 2026-08-14T17:22:05-04:00
downsweep: Cache negative results
When traversing a module graph structure, a uniquely identified node
should always expand to the same thing.
I don't see how visiting the same node which failed to be expanded a
first time would ever successfully expand the second time we try to
expand it (eg. when coming from a different edge to it -- it is still
the same node!). The node expansion is local, based just based on the
node itself, not on the path to get there.
Therefore, this patch removes the weird behavior and commentary of
`dfsBuild` wrt to `Nothing` not being cached and being potentially
expanded a second time around to something different, which was
misleading and, ultimately, incorrect.
Now, we have a `MGRes`, which is more explicit about a node being
Skipped just being a node that is ignored whenever it is found (and that
skip is cached) -- and we may want to do this due to failures or due to
just trying nodes which might not work on purpose, like hs-boots.
We uniformly cache positive and negative results and remove the
assumption that there might be an ordering in which the same node
visited at a later time might be expanded differently.
This makes it possible to traverse the module nodes in parallel without
a change in behavior, since there's no longer a hidden ordering
requirement.
- - - - -
bbd87119 by Rodrigo Mesquita at 2026-08-14T17:22:05-04:00
Organize and clean-up GHC.Driver.Downsweep
Simply some cosmetic changes, moving definitions around to structure the
module better into its relevant sections
(In go (ns ++ ss), it's not a problem to use ++ because it's a good
producer and we won't have to append fully before processing the next
item in go)
- - - - -
05aee047 by mangoiv at 2026-08-14T17:22:07-04:00
hadrian: set the executable bit for hie-bios.bat
- - - - -
21 changed files:
- + changelog.d/downsweep-refactor
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/Unit/Env.hs
- hadrian/hie-bios.bat
- + testsuite/tests/driver/T27461/Main1.hs
- + testsuite/tests/driver/T27461/Main2.hs
- + testsuite/tests/driver/T27461/Makefile
- + testsuite/tests/driver/T27461/T27461a.stderr
- + testsuite/tests/driver/T27461/T27461b.script
- + testsuite/tests/driver/T27461/T27461b.stderr
- + testsuite/tests/driver/T27461/T27461b.stdout
- + testsuite/tests/driver/T27461/all.T
- + testsuite/tests/driver/T27461/src/Bar.hs
- testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
- testsuite/tests/ghc-api/fixed-nodes/InterfaceModuleGraph.hs
- testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
- testsuite/tests/splice-imports/SI35.hs
- utils/check-ppr/Main.hs
Changes:
=====================================
changelog.d/downsweep-refactor
=====================================
@@ -0,0 +1,9 @@
+section: compiler
+synopsis: Significantly improve the performance of downsweep
+issues: #27461
+mrs: !16330
+description: {
+ Rewrite the downsweep pass to make the control flow clearer and fix the
+ caching strategy. Allocations during downsweep in multi-home-unit-heavy and
+ module-heavy tests are reduced by -30% to -60%
+}
=====================================
compiler/GHC/Driver/Backpack.hs
=====================================
@@ -896,7 +896,7 @@ hsModuleToModSummary home_keys pn hsc_src modname
extra_sig_imports <- liftIO $ findExtraSigImports hsc_env hsc_src modname
- (implicit_sigs, inst_deps) <- liftIO $ implicitRequirementsShallow hsc_env textual_imports
+ inst_deps <- liftIO $ implicitRequirementsShallow hsc_env textual_imports
-- So that Finder can find it, even though it doesn't exist...
this_mod <- liftIO $ do
@@ -916,8 +916,7 @@ hsModuleToModSummary home_keys pn hsc_src modname
-- We have to do something special here:
-- due to merging, requirements may end up with
-- extra imports
- ++ (generatedImport FromBackpackSig . noLoc <$> extra_sig_imports)
- ++ (generatedImport FromBackpackSig . noLoc <$> implicit_sigs),
+ ++ (generatedImport FromBackpackSig . noLoc <$> extra_sig_imports),
-- This is our hack to get the parse tree to the right spot
ms_parsed_mod = Just (HsParsedModule {
hpm_module = hsmod,
=====================================
compiler/GHC/Driver/Downsweep.hs
=====================================
@@ -5,6 +5,8 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ViewPatterns #-}
+
+-- | See Note [The ModuleGraph]
module GHC.Driver.Downsweep
( downsweep
, downsweepThunk
@@ -90,7 +92,7 @@ import GHC.Unit.Module.Deps
import qualified GHC.Unit.Home.Graph as HUG
import GHC.Unit.Module.Stage
-import Data.Either ( rights, partitionEithers, lefts )
+import Data.Either ( partitionEithers, lefts )
import qualified Data.Map as Map
import qualified Data.Set as Set
@@ -110,19 +112,39 @@ import Control.Monad.Trans.Reader
import qualified Data.Map.Strict as M
import Control.Monad.Trans.Class
import System.IO.Unsafe (unsafeInterleaveIO)
+import Data.IORef
+import qualified Data.List.NonEmpty as NE
{-
-Note [Downsweep and the ModuleGraph]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [The ModuleGraph]
+~~~~~~~~~~~~~~~~~~~~~~
+The 'ModuleGraph' stores the relationship between all the modules, units, and
+instantiations in the current session, allowing e.g. to answer questions about
+the transitive closure of the imports.
+
+* A /node/ of the `ModuleGraph`, of type `ModuleGraphNode`, corresponds
+ 1-1 with a home-package module of source code, N.hs or N.hs-boot.
+ See the haddocks of `ModuleGraphNode`.
+
+ The `ModuleNodeInfo` field of the `ModuleGraphNode` contains a `ModSummary`
+ that in turn describes where the source file is (its `ModLocation`), when it
+ was read, its contents etc. See Note [Module Types in the ModuleGraph].
-The ModuleGraph stores the relationship between all the modules, units, and
-instantiations in the current session.
+ Each node has a distinct `NodeKey` (an instance of Ord); the function
+ mkNodeKey :: ModuleGraphNode -> NodeKey
+ get the `NodeKey` of a node
-When we do downsweep, we build up a new ModuleGraph, starting from the root
-modules. By following all the dependencies we construct a graph which allows
-us to answer questions about the transitive closure of the imports.
+* An /edge/ of the `ModuleGraph` from N1 to N2 typically corresponds to a
+ direct import of module N2 in module N1: one edge for each import.
+ Imports of modules from non-home-packages are featured in the `ModuleGraph`
+ as `UnitNode`s, or `InstantiationNodes` when backpack is involved.
-The module graph is accessible in the HscEnv.
+ Each node contains a list of all its out-edges or, more precisely, of the
+ `NodeKey`s of its direct dependencies.
+
+Because a node in the `ModuleGraph` describes the precise dependencies of the module, each node has its
+own `UnitId`. Remember, a single module can be compiled against many different versions of a library; but
+once we fix its dependencies we can compile it, and give it a `UnitId`. See Note [About units] in GHC.Unit.
When is this graph constructed?
@@ -139,17 +161,54 @@ When is this graph constructed?
The result is having a uniform graph available for the whole compilation pipeline.
--}
+See Note [Downsweep Control Flow and Caching] for implementation details of
+the algorithm and caching.
+
+Note [Downsweep: building and maintaining the module graph]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The module graph can be built from scratch by starting from a set of /root nodes/
+and exploring their dependencies. This is done by `GHC.Driver.Downsweep.downsweep`.
+
+Another scenario is when we already /have/ a `ModuleGraph` and want to update
+it (e.g. to reflect any file-system changes that have taken place since the
+last invocation of `downsweep`) or augment it by exploring new roots (e.g. for
+incrementally constructing a ModuleGraph using the GHC API; See #27054). So
+`downsweep` takes a `Maybe ModuleGraph` as one of its arguments.
--- This caches the answer to the question, if we are in this unit, what does
--- an import of this module mean.
-type DownsweepCache = M.Map (UnitId, PkgQual, ModuleNameWithIsBoot) [Either DriverMessages ModuleNodeInfo]
+Downsweep iteratively *expands* each so-called 'DownsweepNode' into a list of
+its dependencies, and recursively traverses all reachable nodes in a
+depth-first order using 'dfsBuild'. A 'DownsweepNode' is *expanded* by 'dsNodeExpand':
-moduleGraphNodeMap :: ModuleGraph -> M.Map NodeKey ModuleGraphNode
-moduleGraphNodeMap graph
- = M.fromList [(mkNodeKey node, node) | node <- mgModSummaries' graph]
+ dsNodeExpand :: DownsweepNode -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
+
+Most notably:
+
+ - 'DSMod' (Module-based) nodes can be expanded by preprocessing and
+ parsing the module header, then listing the imports (direct and SOURCE imports)
+ (see 'expandModuleSummary' and 'expandFixedModuleNode')
+
+ - 'DSUnit' is expanded by finding the unit dependencies of that unit by id
+ (see 'expandUnitNode').
+
+Besides its dependencies, expanding a 'DownsweepNode' produces a
+'ModuleGraphNode'. The final 'ModuleGraph' is constructed from the list of
+'ModuleGraphNode's accumulated by expanding all reachable 'DownsweepNode's.
+
+A 'ModuleGraphNode' is essentially the resolved version of 'DownsweepNode':
+it records the payload (e.g. a Module) *and* its dependencies, unlike
+'DownsweepNode' which has the just the payload that is used as a seed (and
+potentially some context information, like the current home-unit)
+
+TL;DR: We recursively traverse 'DownsweepNodes' to discover and build the 'ModuleGraph'.
+
+See also Note [Downsweep Control Flow and Caching] for implementation details.
+See Note [The ModuleGraph] for an overview when we do downsweep.
+-}
-----------------------------------------------------------------------------
+-- * Top-level entry to downsweep
+-----------------------------------------------------------------------------
+
--
-- | Downsweep (dependency analysis) for --make mode
--
@@ -161,7 +220,7 @@ moduleGraphNodeMap graph
-- cache to avoid recalculating a module summary if the source is
-- unchanged.
--
--- Downsweeping can start from scratch for from a given module graph. In the
+-- Downsweeping can start from scratch or from a given module graph. In the
-- latter case, the given graph is fully included in the resulting graph, even
-- if parts of it are not reachable from any of the given roots. When an import
-- is processed, the source of the imported module is not consulted if this
@@ -177,6 +236,8 @@ moduleGraphNodeMap graph
--
-- It will also turn on code generation for any modules that need it by calling
-- 'enableCodeGenForTH'.
+--
+-- See also Note [The ModuleGraph]
downsweep :: HscEnv
-> (GhcMessage -> AnyGhcDiagnostic)
-> Maybe Messager
@@ -194,8 +255,11 @@ downsweep :: HscEnv
-- (Modules, IsBoot) identifiers, unless the Bool is true in
-- which case there can be repeats
downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allow_dup_roots = do
- n_jobs <- mkWorkerLimit (hsc_dflags hsc_env)
- (root_errs, root_summaries) <- rootSummariesParallel n_jobs hsc_env diag_wrapper msg summary
+ n_jobs <- mkWorkerLimit (hsc_dflags hsc_env)
+ summ_cache <- newIORef (mkModSummaryCache (zip old_summaries (repeat SummOld)))
+ imps_cache <- newIORef Map.empty
+ (root_errs, root_summaries) <- rootSummariesParallel n_jobs hsc_env diag_wrapper msg
+ (getRootSummary excl_mods summ_cache imps_cache)
let closure_errs = checkHomeUnitsClosed unit_env
unit_env = hsc_unit_env hsc_env
@@ -203,9 +267,13 @@ downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allo
case all_errs of
[] -> do
- (downsweep_errs, downsweep_nodes) <- downsweepFromRootNodes hsc_env old_summary_map maybe_base_graph excl_mods allow_dup_roots DownsweepUseCompile (map ModuleNodeCompile root_summaries) []
+ (downsweep_errs, downsweep_nodes) <-
+ downsweepFromRootNodes hsc_env summ_cache imps_cache maybe_base_graph
+ excl_mods allow_dup_roots DownsweepUseCompile (map ModuleNodeCompile root_summaries) []
- let (other_errs, unit_nodes) = partitionEithers $ HUG.unitEnv_foldWithKey (\nodes uid hue -> nodes ++ unitModuleNodes downsweep_nodes uid hue) [] (hsc_HUG hsc_env)
+ let (other_errs, unit_nodes) = partitionEithers $
+ HUG.unitEnv_foldWithKey (\nodes uid hue -> nodes ++ unitModuleNodes downsweep_nodes uid hue) []
+ (hsc_HUG hsc_env)
let all_nodes = downsweep_nodes ++ unit_nodes
let all_errs = downsweep_errs ++ other_errs
@@ -221,22 +289,40 @@ downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allo
return (all_errs, th_configured_nodes)
_ -> return (all_errs, emptyMG)
where
- summary = getRootSummary excl_mods old_summary_map
-
- -- A cache from file paths to the already summarised modules. The same file
- -- can be used in multiple units so the map is also keyed by which unit the
- -- file was used in.
- -- Reuse these if we can because the most expensive part of downsweep is
- -- reading the headers.
- old_summary_map :: M.Map (UnitId, OsPath) ModSummary
- old_summary_map =
- M.fromList [((ms_unitid ms, msHsFileOsPath ms), ms) | ms <- old_summaries]
-
-- Dependencies arising on a unit (backpack and module linking deps)
unitModuleNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> [Either (Messages DriverMessage) ModuleGraphNode]
unitModuleNodes summaries uid hue =
maybeToList (linkNodes summaries uid hue)
+ -- The linking plan for each module. If we need to do linking for a home unit
+ -- then this function returns a graph node which depends on all the modules in the home unit.
+
+ -- At the moment nothing can depend on these LinkNodes.
+ linkNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> Maybe (Either (Messages DriverMessage) ModuleGraphNode)
+ linkNodes summaries uid hue =
+ let dflags = homeUnitEnv_dflags hue
+ ofile = outputFile_ dflags
+
+ unit_nodes :: [NodeKey]
+ unit_nodes = map mkNodeKey (filter ((== uid) . mgNodeUnitId) summaries)
+ -- Issue a warning for the confusing case where the user
+ -- said '-o foo' but we're not going to do any linking.
+ -- We attempt linking if either (a) one of the modules is
+ -- called Main, or (b) the user said -no-hs-main, indicating
+ -- that main() is going to come from somewhere else.
+ --
+ no_hs_main = gopt Opt_NoHsMain dflags
+
+ main_sum = any (== NodeKey_Module (ModNodeKeyWithUid (GWIB (mainModuleNameIs dflags) NotBoot) uid)) unit_nodes
+
+ do_linking = main_sum || no_hs_main || ghcLink dflags == LinkDynLib || ghcLink dflags == LinkStaticLib || ghcLink dflags == LinkBytecodeLib
+
+ in if | isExecutableLink (ghcLink dflags) && isJust ofile && not do_linking ->
+ Just (Left $ singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverRedirectedNoMain $ mainModuleNameIs dflags))
+ -- This should be an error, not a warning (#10895).
+ | ghcLink dflags /= NoLink, do_linking -> Just (Right (LinkNode unit_nodes uid))
+ | otherwise -> Nothing
+
-- | Calculate the module graph starting from a single ModSummary. The result is a
-- thunk, which when forced will perform the downsweep. This is useful in oneshot
-- mode where the module graph may never be needed.
@@ -244,7 +330,9 @@ downsweep hsc_env diag_wrapper msg old_summaries maybe_base_graph excl_mods allo
downsweepThunk :: HscEnv -> ModSummary -> IO ModuleGraph
downsweepThunk hsc_env mod_summary = unsafeInterleaveIO $ do
debugTraceMsg (hsc_logger hsc_env) 3 $ text "Computing Module Graph thunk..."
- ~(errs, mg) <- downsweepFromRootNodes hsc_env mempty Nothing [] True DownsweepUseFixed [ModuleNodeCompile mod_summary] []
+ summs <- newIORef (mkModSummaryCache [(mod_summary,SummOld)])
+ imps <- newIORef mempty
+ ~(errs, mg) <- downsweepFromRootNodes hsc_env summs imps Nothing [] True DownsweepUseFixed [ModuleNodeCompile mod_summary] []
let dflags = hsc_dflags hsc_env
liftIO $ printOrThrowDiagnostics (hsc_logger hsc_env)
(initPrintConfig dflags)
@@ -268,80 +356,19 @@ downsweepInteractiveImports hsc_env ic = unsafeInterleaveIO $ do
debugTraceMsg (hsc_logger hsc_env) 3 $ (text "Computing Interactive Module Graph thunk...")
let imps = ic_imports (hsc_IC hsc_env)
- let interactive_mn = icInteractiveModule ic
- -- No sensible value for ModLocation.. if you hit this panic then you probably
- -- need to add proper support for modules without any source files to the driver.
- let ml = pprPanic "modLocation" (ppr interactive_mn <+> ppr imps)
- let key = moduleToMnk interactive_mn NotBoot
- let node_type = ModuleNodeFixed key ml
+ interactive_mn = icInteractiveModule ic
-- The existing nodes in the module graph. This will be populated when GHCi runs
-- :load. Any home package modules need to already be in here.
- let cached_nodes = Map.fromList [ (mkNodeKey n, n) | n <- mg_mss (hsc_mod_graph hsc_env) ]
-
- (module_edges, graph) <- loopFromInteractive hsc_env (map mkEdge imps) cached_nodes
- let interactive_node = ModuleNode module_edges node_type
-
- let all_nodes = M.elems graph
- return $ mkModuleGraph (interactive_node : all_nodes)
-
- where
- --
- mkEdge :: InteractiveImport -> Either ModuleNodeEdge (UnitId, UnresolvedImport PkgQual)
- -- A simple edge to a module from the same home unit
- mkEdge (IIModule n) =
- let
- mod_node_key = ModNodeKeyWithUid
- { mnkModuleName = GWIB (moduleName n) NotBoot
- , mnkUnitId =
- -- 'toUnitId' is safe here, as we can't import modules that
- -- don't have a 'UnitId'.
- toUnitId (moduleUnit n)
- }
- mod_node_edge =
- ModuleNodeEdge NormalLevel (NodeKey_Module mod_node_key)
- in Left mod_node_edge
- -- A complete import statement
- mkEdge (IIDecl i) =
- let unitId = homeUnitId $ hsc_home_unit hsc_env
- imp = rnUnresolvedImportPkgQual (renameRawPkgQual (hsc_unit_env hsc_env))
- (mkUnresolvedImport i)
- in Right (unitId, imp)
-
-loopFromInteractive :: HscEnv
- -> [Either ModuleNodeEdge (UnitId, UnresolvedImport PkgQual)]
- -> M.Map NodeKey ModuleGraphNode
- -> IO ([ModuleNodeEdge],M.Map NodeKey ModuleGraphNode)
-loopFromInteractive _ [] cached_nodes = return ([], cached_nodes)
-loopFromInteractive hsc_env (edge:edges) cached_nodes =
- case edge of
- Left edge -> do
- (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes
- return (edge : edges, cached_nodes')
- Right (unitId, imp@(UnresolvedImport { ui_level = lvl, ui_boot = is_boot })) -> do
- let home_unit = ue_unitHomeUnit unitId (hsc_unit_env hsc_env)
- let k _ loc mod =
- let key = moduleToMnk mod is_boot
- in return $ FoundHome (ModuleNodeFixed key loc)
- found <- liftIO $ summariseModuleDispatch k hsc_env home_unit imp []
- case found of
- -- Case 1: Home modules have to already be in the cache.
- FoundHome (ModuleNodeFixed mod _) -> do
- let edge = ModuleNodeEdge lvl (NodeKey_Module mod)
- -- Note: Does not perform any further downsweep as the module must already be in the cache.
- (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes
- return (edge : edges, cached_nodes')
- -- Case 2: External units may not be in the cache, if we haven't already initialised the
- -- module graph. We can construct the module graph for those here by calling loopUnit.
- External uid -> do
- let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env
- cached_nodes' = loopUnit hsc_env' cached_nodes [uid]
- edge = ModuleNodeEdge lvl (NodeKey_ExternalUnit uid)
- (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes'
- return (edge : edges, cached_nodes')
- -- And if it's not found.. just carry on and hope.
- _ -> loopFromInteractive hsc_env edges cached_nodes
+ let cached_nodes = Map.fromList [ (mkNodeKey n, NSuccess n) | n <- mg_mss (hsc_mod_graph hsc_env) ]
+ summ_cache <- newIORef mempty
+ imps_cache <- newIORef mempty
+ let env = DownsweepEnv hsc_env DownsweepUseFixed{-or DownsweepUseCompile?-} summ_cache imps_cache []
+ graph <- runDownsweepM env do
+ loopFromInteractive cached_nodes interactive_mn imps
+ let all_nodes = [s | NSuccess s <- M.elems graph ]
+ return $ mkModuleGraph all_nodes
-- | Create a module graph from a list of installed modules.
-- This is used by the loader when we need to load modules but there
@@ -370,7 +397,9 @@ downsweepInstalledModules hsc_env mods = do
_ -> throwGhcException $ ProgramError $ showSDoc (hsc_dflags hsc_env) $ text "downsweepInstalledModules: Could not find installed module" <+> ppr i
nodes <- mapM process installed_mods
- (errs, mg) <- downsweepFromRootNodes hsc_env mempty Nothing [] True DownsweepUseFixed nodes external_uids
+ summs <- newIORef mempty
+ imps <- newIORef mempty
+ (errs, mg) <- downsweepFromRootNodes hsc_env summs imps Nothing [] True DownsweepUseFixed nodes external_uids
-- Similarly here, we should really not get any errors, but print them out if we do.
let dflags = hsc_dflags hsc_env
@@ -381,7 +410,35 @@ downsweepInstalledModules hsc_env mods = do
return (mkModuleGraph mg)
+-----------------------------------------------------------------------------
+-- * Orchestrator: downsweepFromRootNodes
+-----------------------------------------------------------------------------
+
+type ModSummaryCache = IORef ModSummaryCacheMap
+type ImportsCache = IORef ImportsCacheMap
+-- | A cache from file paths to the already summarised modules. The same file
+-- can be used in multiple units so the map is actually also keyed by which
+-- unit the file was used in.
+--
+-- We want to reuse ModSummaries as far as possible because the most expensive
+-- part of downsweep is reading and parsing the headers.
+--
+-- See Note [Downsweep Control Flow and Caching]
+type ModSummaryCacheMap
+ -- The cache can't be keyed by 'Module' because that isn't sufficient to
+ -- distinguish .hs from .hs-boot files. Use path+unit instead.
+ = ( M.Map (UnitId, OsPath) (Either DriverMessages (ModSummary, SummProvenance)) )
+
+-- | A 'ModSummary's provenance during downsweep: an old previously constructed
+-- ModSummary, that might be potentially outdated, or a freshly constructed one
+-- during this downsweep which is certainly up to date?
+data SummProvenance
+ -- | Constructed during this downsweep: trivially up to date
+ = SummFresh
+ -- | Carried over from a previous run: may be stale, must be hash-checked
+ -- (and considered by -fforce-recomp)
+ | SummOld
-- | Whether downsweep should use compiler or fixed nodes. Compile nodes are used
-- by --make mode, and fixed nodes by oneshot mode.
@@ -394,7 +451,8 @@ data DownsweepMode = DownsweepUseCompile | DownsweepUseFixed
-- This function will start at the given roots, and traverse downwards to find
-- all the dependencies, all the way to the leaf units.
downsweepFromRootNodes :: HscEnv
- -> M.Map (UnitId, OsPath) ModSummary
+ -> ModSummaryCache
+ -> ImportsCache
-> Maybe ModuleGraph
-> [ModuleName]
-> Bool
@@ -402,278 +460,368 @@ downsweepFromRootNodes :: HscEnv
-> [ModuleNodeInfo] -- ^ The starting ModuleNodeInfo
-> [UnitId] -- ^ The starting units
-> IO ([DriverMessages], [ModuleGraphNode])
-downsweepFromRootNodes hsc_env old_summaries maybe_base_graph excl_mods allow_dup_roots mode root_nodes root_uids
- = do
- let root_map = mkRootMap root_nodes
- checkDuplicates root_map
- let env = DownsweepEnv hsc_env mode old_summaries excl_mods
- (deps', map0) <- runDownsweepM env $ do
- let base_nodes = maybe M.empty moduleGraphNodeMap maybe_base_graph
- (module_deps, map0) <- loopModuleNodeInfos root_nodes (base_nodes, root_map)
- let all_deps = loopUnit hsc_env module_deps root_uids
- let all_instantiations = getHomeUnitInstantiations hsc_env
- deps' <- loopInstantiations all_instantiations all_deps
- return (deps', map0)
-
-
- let downsweep_errs = lefts $ concat $ M.elems map0
- downsweep_nodes = M.elems deps'
-
- return (downsweep_errs, downsweep_nodes)
- where
- getHomeUnitInstantiations :: HscEnv -> [(UnitId, InstantiatedUnit)]
- getHomeUnitInstantiations hsc_env = HUG.unitEnv_foldWithKey (\nodes uid hue -> nodes ++ instantiationNodes uid (homeUnitEnv_units hue)) [] (hsc_HUG hsc_env)
-
- -- In a root module, the filename is allowed to diverge from the module
- -- name, so we have to check that there aren't multiple root files
- -- defining the same module (otherwise the duplicates will be silently
- -- ignored, leading to confusing behaviour).
- checkDuplicates
- :: DownsweepCache
- -> IO ()
- checkDuplicates root_map
- | not allow_dup_roots
- , dup_root:_ <- dup_roots = liftIO $ multiRootsErr sec dup_root
- | otherwise = pure ()
- where
- sec = initSourceErrorContext (hsc_dflags hsc_env)
- dup_roots :: [[ModuleNodeInfo]] -- Each at least of length 2
- dup_roots = filterOut isSingleton $ map rights (M.elems root_map)
-
-
-calcDeps :: ModSummary -> [(UnitId, UnresolvedImport PkgQual)]
-calcDeps ms =
- -- Add a dependency on the HsBoot file if it exists
- -- This gets passed to the loopImports function which just ignores it if it
- -- can't be found.
- [ (ms_unitid ms, self_boot) | NotBoot <- [isBootSummary ms] ] ++
- [ (ms_unitid ms, e) | e <- ms_imps ms ]
+downsweepFromRootNodes hsc_env summ_cache imps_cache maybe_base_graph excl_mods allow_dup_roots mode root_nodes root_uids = do
+ when (not allow_dup_roots) $
+ case root_duplicates of
+ [] -> return ()
+ (dup_root:_) -> multiRootsErr sec dup_root
+ modifyImpsCache imps_cache (`M.union` mkRootMap root_nodes) -- add root nodes to imports cache
+ let env = DownsweepEnv hsc_env mode summ_cache imps_cache excl_mods
+ deps' <- runDownsweepM env $ do
+ let base_nodes = maybe M.empty moduleGraphNodeMap maybe_base_graph
+ module_deps <- loopModuleNodeInfos base_nodes root_nodes
+ all_deps <- loopUnits module_deps (hscActiveUnitId hsc_env) root_uids
+ deps' <- loopInstantiations all_deps (getHomeUnitInstantiations hsc_env)
+ return deps'
+ f_cache <- readIORef summ_cache
+ let downsweep_errs = lefts (M.elems f_cache)
+ downsweep_nodes = [ s | NSuccess s <- M.elems deps' ]
+
+ return (downsweep_errs, downsweep_nodes)
where
- self_boot = (generatedImport FromSelfBoot (noLoc (ms_mod_name ms)))
- { ui_boot = IsBoot }
-
+ getHomeUnitInstantiations :: HscEnv -> [(UnitId, InstantiatedUnit)]
+ getHomeUnitInstantiations hsc_env = HUG.unitEnv_foldWithKey
+ (\nodes uid hue -> nodes ++ instantiationNodes uid (homeUnitEnv_units hue)) [] (hsc_HUG hsc_env)
+
+ -- In a root module, the filename is allowed to diverge from the module
+ -- name, so we have to check that there aren't multiple root files
+ -- defining the same module (otherwise the duplicates will be silently
+ -- ignored, leading to confusing behaviour).
+ root_duplicates :: [NE.NonEmpty ModuleNodeInfo]
+ root_duplicates = mapMaybe takes2 (M.elems root_map)
+ where
+ takes2 (a:as@(_:_)) = Just (a NE.:| as) -- Each at least of length 2
+ takes2 _ = Nothing
+
+ root_map = Map.fromListWith (flip (++))
+ [ ((moduleNodeInfoUnitId s, moduleNodeInfoMnwib s), [s])
+ | s <- root_nodes ]
+
+ moduleGraphNodeMap :: ModuleGraph -> M.Map NodeKey (NodeRes ModuleGraphNode)
+ moduleGraphNodeMap graph
+ = M.fromList [(mkNodeKey node, NSuccess node) | node <- mgModSummaries' graph]
+
+ sec = initSourceErrorContext (hsc_dflags hsc_env)
+
+--------------------------------------------------------------------------------
+-- ** 'DownsweepM'
+--------------------------------------------------------------------------------
type DownsweepM a = ReaderT DownsweepEnv IO a
data DownsweepEnv = DownsweepEnv {
downsweep_hsc_env :: HscEnv
, _downsweep_mode :: DownsweepMode
- , _downsweep_old_summaries :: M.Map (UnitId, OsPath) ModSummary
+ , _downsweep_summaries_cache :: ModSummaryCache
+ , downsweep_imports_cache :: ImportsCache
, _downsweep_excl_mods :: [ModuleName]
}
+mkModSummaryCache :: [(ModSummary, SummProvenance)] -> ModSummaryCacheMap
+mkModSummaryCache summs = foldl' (flip (uncurry addModSummaryCache)) M.empty summs
+
+addModSummaryCache :: ModSummary -> SummProvenance -> ModSummaryCacheMap -> ModSummaryCacheMap
+addModSummaryCache ms pr fe = upd_fe fe
+ where
+ upd_fe fe
+ | Just src_fn_os <- ml_hs_file_ospath (ms_location ms)
+ = M.insert (ms_unitid ms, src_fn_os) (Right (ms, pr)) fe
+ | otherwise = fe
+
+modifySummCache :: ModSummaryCache -> (ModSummaryCacheMap -> ModSummaryCacheMap) -> IO ()
+modifyImpsCache :: ImportsCache -> (ImportsCacheMap -> ImportsCacheMap) -> IO ()
+modifySummCache r f = atomicModifyIORef' r (\c -> (f c, ()))
+modifyImpsCache r f = atomicModifyIORef' r (\c -> (f c, ()))
+
+-- | A cache from a module import (in given home unit context, with a package
+-- qualifier, and the imported module name (with or without SOURCE)) to the
+-- result of summarising that import (see 'summariseModuleDispatch').
+--
+-- See Note [Downsweep Control Flow and Caching]
+type ImportsCacheMap
+ = M.Map (UnitId, PkgQual, ModuleNameWithIsBoot) SummariseResult
+
+-- | Populate the 'ImportsCacheMap' with the root modules.
+mkRootMap :: [ModuleNodeInfo] -> ImportsCacheMap
+mkRootMap summaries = Map.fromList
+ [ ((moduleNodeInfoUnitId s, NoPkgQual, moduleNodeInfoMnwib s), FoundHome s) | s <- summaries ]
+
runDownsweepM :: DownsweepEnv -> DownsweepM a -> IO a
runDownsweepM env act = runReaderT act env
-
-loopInstantiations :: [(UnitId, InstantiatedUnit)]
- -> M.Map NodeKey ModuleGraphNode
- -> DownsweepM (M.Map NodeKey ModuleGraphNode)
-loopInstantiations [] done = pure done
-loopInstantiations ((home_uid, iud) :xs) done = do
- hsc_env <- asks downsweep_hsc_env
- let home_unit = ue_unitHomeUnit home_uid (hsc_unit_env hsc_env)
- let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env
- done' = loopUnit hsc_env' done [instUnitInstanceOf iud]
- payload = InstantiationNode home_uid iud
- loopInstantiations xs (M.insert (mkNodeKey payload) payload done')
-
-
--- This loops over all the mod summaries in the dependency graph, accumulates the actual dependencies for each module/unit
-loopSummaries :: [ModSummary]
- -> (M.Map NodeKey ModuleGraphNode,
- DownsweepCache)
- -> DownsweepM ((M.Map NodeKey ModuleGraphNode), DownsweepCache)
-loopSummaries [] done = pure done
-loopSummaries (ms:next) (done, summarised)
- | Just {} <- M.lookup k done
- = loopSummaries next (done, summarised)
- -- Didn't work out what the imports mean yet, now do that.
- | otherwise = do
- (final_deps, done', summarised') <- loopImports (calcDeps ms) done summarised
- -- This has the effect of finding a .hs file if we are looking at the .hs-boot file.
- (_, done'', summarised'') <- loopImports (maybeToList hs_file_for_boot) done' summarised'
- loopSummaries next (M.insert k (ModuleNode final_deps (ModuleNodeCompile ms)) done'', summarised'')
+loopDownsweepNodes :: M.Map NodeKey (NodeRes ModuleGraphNode) -> [DownsweepNode] -> DownsweepM (M.Map NodeKey (NodeRes ModuleGraphNode))
+loopModuleNodeInfos :: M.Map NodeKey (NodeRes ModuleGraphNode) -> [ModuleNodeInfo] -> DownsweepM (M.Map NodeKey (NodeRes ModuleGraphNode))
+loopUnits :: M.Map NodeKey (NodeRes ModuleGraphNode) -> UnitId -> [UnitId] -> DownsweepM (M.Map NodeKey (NodeRes ModuleGraphNode))
+loopInstantiations :: M.Map NodeKey (NodeRes ModuleGraphNode) -> [(UnitId, InstantiatedUnit)] -> DownsweepM (M.Map NodeKey (NodeRes ModuleGraphNode))
+loopFromInteractive :: M.Map NodeKey (NodeRes ModuleGraphNode) -> Module -> [InteractiveImport] -> DownsweepM (M.Map NodeKey (NodeRes ModuleGraphNode))
+loopDownsweepNodes base_map nodes = dfsBuild (Just base_map) nodes dsNodeInfoKey dsNodeExpand
+loopModuleNodeInfos base_map = loopDownsweepNodes base_map . map DSMod
+loopUnits base_map homud = loopDownsweepNodes base_map . map (DSUnit homud)
+loopInstantiations base_map = loopDownsweepNodes base_map . map (uncurry DSInst)
+loopFromInteractive base_map m = loopDownsweepNodes base_map . (:[]) . DSInteractive m
+
+--------------------------------------------------------------------------------
+-- * Expanding 'DownsweepNode's into payload and node dependencies
+--------------------------------------------------------------------------------
+
+-- | A 'DownsweepNode' is the basic block of the downsweep algorithm which
+-- encompasses the types of nodes we can iteratively expand to construct the
+-- full module graph. See 'loopDownsweepNodes'.
+--
+-- See Note [Downsweep Control Flow and Caching]
+data DownsweepNode
+ -- | A module node to expand
+ = DSMod ModuleNodeInfo
+ -- | A unit node to expand
+ | DSUnit
+ { home_context_uid :: UnitId
+ -- ^ The home unit which introduced the dependency on this 'node_uid'. This
+ -- 'node_uid' can only be expanded in the context ('HscEnv') where
+ -- 'home_context_uid' is the active home unit, to make sure the package flags
+ -- are the ones attributed to the home package that introduced this node.
+ , node_uid :: UnitId
+ -- ^ The unit node to expand
+ }
+ -- | FIXME: document the meaning of 'DSInst'
+ | DSInst
+ { home_context_uid :: UnitId
+ , instantiated_ud :: InstantiatedUnit
+ }
+ -- | A group of interactive imports from this interactive Module
+ | DSInteractive Module [InteractiveImport]
+
+instance Outputable DownsweepNode where
+ ppr = \case
+ DSMod (ModuleNodeCompile ms) -> text "DSModC" <+> ppr (ms_mod_name ms)
+ DSMod (ModuleNodeFixed key _) -> text "DSModF" <+> ppr key
+ DSUnit{node_uid} -> text "DSUnit" <+> ppr node_uid
+ DSInst{instantiated_ud} -> text "DSInst" <+> ppr instantiated_ud
+ DSInteractive mod ii -> text "DSInteractive" <+> ppr mod <+> ppr ii
+
+-- | They key by which to cache previously visited 'DownsweepNode's
+dsNodeInfoKey :: DownsweepNode -> NodeKey
+dsNodeInfoKey = \case
+ DSMod (ModuleNodeCompile ms) -> NodeKey_Module (msKey ms)
+ DSMod (ModuleNodeFixed mod _) -> NodeKey_Module mod
+ DSUnit{node_uid} -> NodeKey_ExternalUnit node_uid
+ DSInst{instantiated_ud} -> NodeKey_Unit instantiated_ud
+ DSInteractive mod _imps -> NodeKey_Module $ moduleToMnk mod NotBoot
+
+dsNodeExpand :: DownsweepNode -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
+dsNodeExpand = \case
+ DSMod (ModuleNodeCompile ms) -> expandModuleSummary ms
+ DSMod (ModuleNodeFixed key loc) -> expandFixedModuleNode key loc
+ DSUnit{ node_uid, home_context_uid } -> expandUnitNode node_uid home_context_uid
+ DSInst{ instantiated_ud
+ , home_context_uid } -> expandInstantiatedUnit instantiated_ud home_context_uid
+ DSInteractive imod iis -> expandInteractiveImports imod iis
+
+expandModuleSummary :: ModSummary -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
+expandModuleSummary ms = do -- Didn't work out what the imports mean yet, now do that.
+ hsc_env <- asks downsweep_hsc_env
+ let home_uid = ms_unitid ms
+ home_unit = ue_unitHomeUnit home_uid (hsc_unit_env hsc_env)
+ (final_deps, todo) <- unzip <$> mapM (expandModImport home_uid home_unit) (calcDeps ms)
+
+ -- This has the effect of finding a .hs file if we are looking at the .hs-boot file.
+ boot_todo <-
+ if | HsBootFile <- ms_hsc_src ms
+ -> do
+ r <- downsweepSummarise home_unit (generatedImport FromSelfBoot (noLoc (ms_mod_name ms))) Nothing
+ case r of
+ FoundHome s -> pure [DSMod s]
+ _ -> pure []
+ | otherwise -> pure []
+
+ return $ NSuccess
+ ( ModuleNode (catMaybes final_deps) (ModuleNodeCompile ms)
+ , boot_todo ++ concat todo
+ )
where
- k = NodeKey_Module (msKey ms)
-
- hs_file_for_boot
- | HsBootFile <- ms_hsc_src ms
- = Just ( ms_unitid ms
- , generatedImport FromSelfBoot (noLoc (ms_mod_name ms)) )
- | otherwise
- = Nothing
-
-loopModuleNodeInfos :: [ModuleNodeInfo] -> (M.Map NodeKey ModuleGraphNode, DownsweepCache) -> DownsweepM (M.Map NodeKey ModuleGraphNode, DownsweepCache)
-loopModuleNodeInfos is cache = foldM (flip loopModuleNodeInfo) cache is
-
-loopModuleNodeInfo :: ModuleNodeInfo -> (M.Map NodeKey ModuleGraphNode, DownsweepCache) -> DownsweepM (M.Map NodeKey ModuleGraphNode, DownsweepCache)
-loopModuleNodeInfo mod_node_info (done, summarised) = do
- case mod_node_info of
- ModuleNodeCompile ms -> do
- loopSummaries [ms] (done, summarised)
- ModuleNodeFixed mod ml -> do
- done' <- loopFixedModule mod ml done
- return (done', summarised)
-
--- NB: loopFixedModule does not take a downsweep cache, because if you
--- ever reach a Fixed node, everything under that also must be fixed.
-loopFixedModule :: ModNodeKeyWithUid -> ModLocation
- -> M.Map NodeKey ModuleGraphNode
- -> DownsweepM (M.Map NodeKey ModuleGraphNode)
-loopFixedModule key loc done = do
- let nk = NodeKey_Module key
- hsc_env <- asks downsweep_hsc_env
- case M.lookup nk done of
- Just {} -> return done
- Nothing -> do
- -- MP: TODO, we should just read the dependency info from the interface rather than either
- -- a. Loading the whole thing into the EPS (this might never nececssary and causes lots of things to be permanently loaded into memory)
- -- b. Loading the whole interface into a buffer before discarding it. (wasted allocation and deserialisation)
- read_result <- liftIO $
- -- 1. Check if the interface is already loaded into the EPS by some other
- -- part of the compiler.
- lookupIfaceByModuleHsc hsc_env (mnkToModule key) >>= \case
- Just iface -> return (M.Succeeded iface)
- Nothing -> readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule key) (ml_hi_file loc)
- case read_result of
- M.Succeeded iface -> do
- -- Computer information about this node
- let node_deps = ifaceDeps (mi_deps iface)
- edges = map mkFixedEdge node_deps
- node = ModuleNode edges (ModuleNodeFixed key loc)
- foldM (loopFixedNodeKey (mnkUnitId key)) (M.insert nk node done) (bimap snd snd <$> node_deps)
- -- Ignore any failure, we might try to read a .hi-boot file for
- -- example, even if there is not one.
- M.Failed {} ->
- return done
-
-loopFixedNodeKey :: UnitId -> M.Map NodeKey ModuleGraphNode -> Either ModNodeKeyWithUid UnitId -> DownsweepM (M.Map NodeKey ModuleGraphNode)
-loopFixedNodeKey _ done (Left key) = do
- loopFixedImports [key] done
-loopFixedNodeKey home_uid done (Right uid) = do
- -- Set active unit so that looking loopUnit finds the correct
- -- -package flags in the unit state.
- hsc_env <- asks downsweep_hsc_env
- let hsc_env' = hscSetActiveUnitId home_uid hsc_env
- return $ loopUnit hsc_env' done [uid]
-
-mkFixedEdge :: Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId) -> ModuleNodeEdge
-mkFixedEdge (Left (lvl, key)) = mkModuleEdge lvl (NodeKey_Module key)
-mkFixedEdge (Right (lvl, uid)) = mkModuleEdge lvl (NodeKey_ExternalUnit uid)
-
-ifaceDeps :: Dependencies -> [Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId)]
-ifaceDeps deps =
- [ Left (tcImportLevel lvl, ModNodeKeyWithUid dep uid)
- | (lvl, uid, dep) <- Set.toList (dep_direct_mods deps)
- ] ++
- [ Right (tcImportLevel lvl, uid)
- | (lvl, uid) <- Set.toList (dep_direct_pkgs deps)
- ]
-
--- Like loopImports, but we already know exactly which module we are looking for.
-loopFixedImports :: [ModNodeKeyWithUid]
- -> M.Map NodeKey ModuleGraphNode
- -> DownsweepM (M.Map NodeKey ModuleGraphNode)
-loopFixedImports [] done = pure done
-loopFixedImports (key:keys) done = do
- let nk = NodeKey_Module key
- hsc_env <- asks downsweep_hsc_env
- case M.lookup nk done of
- Just {} -> loopFixedImports keys done
- Nothing -> do
+ expandModImport home_uid home_unit imp = do
+ let UnresolvedImport { ui_level = lvl } = imp
+ mb_s <- downsweepSummarise home_unit imp Nothing
+ case mb_s of
+ NotThere -> return
+ ( Nothing, [] )
+ External uid -> return
+ ( Just $ mkModuleEdge lvl (NodeKey_ExternalUnit uid)
+ -- Specify home unit, as each unit might have a different visible package database.
+ , [DSUnit{node_uid = uid, home_context_uid = home_uid}] )
+ FoundInstantiation iud -> return
+ ( Just (mkModuleEdge lvl (NodeKey_Unit iud)), [] )
+ FoundHomeWithError (_uid, _e) -> return
+ ( Nothing, [] )
+ -- the error @e@ is already stored in the summarisation cache,
+ -- (the IORef in DownsweepM) and will get reported at the end.
+ FoundHome s -> return
+ -- MP: This assumes that we can only instantiate non home units, which is probably fair enough for now.
+ ( Just $ mkModuleEdge lvl (NodeKey_Module (mnKey s))
+ , [DSMod s] )
+
+ calcDeps :: ModSummary -> [UnresolvedImport PkgQual]
+ calcDeps ms =
+ -- Add a dependency on the HsBoot file if it exists
+ -- This gets passed to the loopImports function which just ignores it if it
+ -- can't be found.
+ [ self_boot | NotBoot <- [isBootSummary ms] ] ++
+ [ e | e <- ms_imps ms ]
+ where
+ self_boot = (generatedImport FromSelfBoot (noLoc (ms_mod_name ms)))
+ { ui_boot = IsBoot }
+
+-- | Expand a 'ModuleNodeFixed' node
+-- NB: If you ever reach a Fixed node, everything under that also must be fixed.
+expandFixedModuleNode :: ModNodeKeyWithUid -> ModLocation -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
+expandFixedModuleNode key loc = do
+ hsc_env <- asks downsweep_hsc_env
+ -- MP: TODO, we should just read the dependency info from the interface rather than either
+ -- a. Loading the whole thing into the EPS (this might never nececssary and causes lots of things to be permanently loaded into memory)
+ -- b. Loading the whole interface into a buffer before discarding it. (wasted allocation and deserialisation)
+ read_result <- liftIO $
+ -- 1. Check if the interface is already loaded into the EPS by some other
+ -- part of the compiler.
+ lookupIfaceByModuleHsc hsc_env (mnkToModule key) >>= \case
+ Just iface -> return (M.Succeeded iface)
+ Nothing -> readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule key) (ml_hi_file loc)
+ case read_result of
+ M.Succeeded iface -> do
+ -- Computer information about this node
+ let node_deps = ifaceDeps (mi_deps iface)
+ edges = map mkFixedEdge node_deps
+ node = ModuleNode edges (ModuleNodeFixed key loc)
+ deps' <- catMaybes <$> mapM (mk_dep hsc_env) (bimap snd snd <$> node_deps)
+ pure $ NSuccess (node, deps')
+
+ -- Skip any failure, we might try to read a .hi-boot file for
+ -- example, even if there is not one.
+ M.Failed {} ->
+ pure NSkip
+ where
+ mk_dep hsc_env (Left key) = do
+ -- Like expandImports, but we already know exactly which module we are looking for.
read_result <- liftIO $ findExactModule hsc_env (mnkToInstalledModule key) (mnkIsBoot key)
case read_result of
InstalledFound loc -> do
- done' <- loopFixedModule key loc done
- loopFixedImports keys done'
+ pure $ Just $ DSMod (ModuleNodeFixed key loc)
_otherwise ->
-- If the finder fails, just keep going, there will be another
- -- error later.
- loopFixedImports keys done
+ -- error later when we try to expand this dependency.
+ pure Nothing
+ mk_dep _ (Right uid_dep) = do
+ -- Set active unit so that looking loopUnit finds the correct
+ -- -package flags in the unit state.
+ let home_uid = mnkUnitId key
+ pure (Just DSUnit{node_uid=uid_dep, home_context_uid=home_uid})
+
+ mkFixedEdge :: Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId) -> ModuleNodeEdge
+ mkFixedEdge (Left (lvl, key)) = mkModuleEdge lvl (NodeKey_Module key)
+ mkFixedEdge (Right (lvl, uid)) = mkModuleEdge lvl (NodeKey_ExternalUnit uid)
+
+ ifaceDeps :: Dependencies -> [Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId)]
+ ifaceDeps deps =
+ [ Left (tcImportLevel lvl, ModNodeKeyWithUid dep uid)
+ | (lvl, uid, dep) <- Set.toList (dep_direct_mods deps)
+ ] ++
+ [ Right (tcImportLevel lvl, uid)
+ | (lvl, uid) <- Set.toList (dep_direct_pkgs deps)
+ ]
+
+-- | Expand a unit id under the context of a certain home unit
+expandUnitNode :: UnitId {-^ @node_uid@ -} -> UnitId {-^ Home unit from where @node_uid@ was introduced -}
+ -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
+expandUnitNode node_uid home_context_uid = do
+ -- Set active unit so that looking loopUnit finds the correct
+ -- -package flags in the unit state.
+ hsc_env <- asks downsweep_hsc_env
+ let lcl_hsc_env = hscSetActiveUnitId home_context_uid hsc_env
+ case unitDepends <$> lookupUnitId (hsc_units lcl_hsc_env) node_uid of
+ Just us -> pure $ NSuccess ((UnitNode us node_uid), map (\u -> DSUnit{node_uid=u, home_context_uid{-inherit-}}) us)
+ Nothing -> pprPanic "loopUnit" (text "Malformed package database, missing " <+> ppr node_uid)
+
+expandInstantiatedUnit :: InstantiatedUnit -> UnitId {-^ Home unit -} -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
+expandInstantiatedUnit iud home_uid = pure $ NSuccess
+ ( InstantiationNode home_uid iud
+ , [DSUnit{node_uid=instUnitInstanceOf iud, home_context_uid=home_uid}] )
+
+expandInteractiveImports :: Module -> [InteractiveImport] -> DownsweepM (NodeRes (ModuleGraphNode, [DownsweepNode]))
+expandInteractiveImports imod imps = do
+ hsc_env <- asks downsweep_hsc_env
+ imps_cache <- asks downsweep_imports_cache
+
+ let
+ -- A simple edge to a module from the same home unit
+ mkEdge (IIModule n) = return $
+ let
+ mod_node_key = ModNodeKeyWithUid
+ { mnkModuleName = GWIB (moduleName n) NotBoot
+ , mnkUnitId =
+ -- 'toUnitId' is safe here, as we can't import modules that
+ -- don't have a 'UnitId'.
+ toUnitId (moduleUnit n)
+ }
+ in (Just $ ModuleNodeEdge NormalLevel (NodeKey_Module mod_node_key), [])
+
+ -- A complete import statement
+ mkEdge (IIDecl i) =
+ let unitId = homeUnitId $ hsc_home_unit hsc_env
+ imp = rnUnresolvedImportPkgQual (renameRawPkgQual (hsc_unit_env hsc_env))
+ (mkUnresolvedImport i)
+ UnresolvedImport { ui_level = lvl, ui_boot = is_boot } = imp
+ in do
+ let home_unit = ue_unitHomeUnit unitId (hsc_unit_env hsc_env)
+ let k _ loc mod =
+ let key = moduleToMnk mod is_boot
+ in return $ FoundHome (ModuleNodeFixed key loc)
+
+ found <- liftIO $ summariseModuleDispatch k hsc_env imps_cache home_unit imp []
+ case found of
+ -- Case 1: Home modules have to already be in the cache.
+ FoundHome (ModuleNodeFixed mod _) -> do
+ let edge = ModuleNodeEdge lvl (NodeKey_Module mod)
+ -- Note: Does not perform any further downsweep as the module must already be in the cache.
+ return (Just edge, [])
+ -- Case 2: External units may not be in the cache, if we haven't already initialised the
+ -- module graph. We can construct the module graph for those here by calling loopUnit.
+ External uid -> do
+ let edge = ModuleNodeEdge lvl (NodeKey_ExternalUnit uid)
+ return (Just edge, [DSUnit{node_uid=uid, home_context_uid=homeUnitId home_unit}])
+ -- And if it's not found.. just carry on and hope.
+ _ -> return (Nothing, [])
+
+ (module_edges, todo) <- unzip <$> mapM mkEdge imps
+ pure $ NSuccess
+ ( ModuleNode (catMaybes module_edges) node_type, concat todo )
+ where
+ -- No sensible value for ModLocation.. if you hit this panic then you probably
+ -- need to add proper support for modules without any source files to the driver.
+ ml = pprPanic "modLocation" (ppr imod <+> ppr imps)
+ key = moduleToMnk imod NotBoot
+ node_type = ModuleNodeFixed key ml
+
+--------------------------------------------------------------------------------
+-- * Constructing Module Summaries
+--------------------------------------------------------------------------------
downsweepSummarise :: HomeUnit
-> UnresolvedImport PkgQual
-> Maybe (StringBuffer, UTCTime)
-> DownsweepM SummariseResult
downsweepSummarise home_unit imp maybe_buf = do
- DownsweepEnv hsc_env mode old_summaries excl_mods <- ask
- case mode of
- DownsweepUseCompile -> liftIO $ summariseModule hsc_env home_unit old_summaries imp maybe_buf excl_mods
- DownsweepUseFixed -> liftIO $ summariseModuleInterface hsc_env home_unit imp excl_mods
-
-
--- This loops over each import in each summary. It is mutually recursive with loopSummaries if we discover
--- a new module by doing this.
-loopImports :: [(UnitId, UnresolvedImport PkgQual)]
- -- Work list: process these modules
- -> M.Map NodeKey ModuleGraphNode
- -> DownsweepCache
- -- Visited set; the range is a list because
- -- the roots can have the same module names
- -- if allow_dup_roots is True
- -> DownsweepM ([ModuleNodeEdge],
- M.Map NodeKey ModuleGraphNode, DownsweepCache)
- -- The result is the completed NodeMap
-loopImports [] done summarised = return ([], done, summarised)
-loopImports ((home_uid, imp) : ss) done summarised
- | Just summs <- M.lookup cache_key summarised
- = case summs of
- [Right ms] -> do
- let nk = mkModuleEdge lvl (NodeKey_Module (mnKey ms))
- (rest, summarised', done') <- loopImports ss done summarised
- return (nk: rest, summarised', done')
- [Left _err] ->
- loopImports ss done summarised
- _errs -> do
- loopImports ss done summarised
- | otherwise
- = do
- hsc_env <- asks downsweep_hsc_env
- let home_unit = ue_unitHomeUnit home_uid (hsc_unit_env hsc_env)
- mb_s <- downsweepSummarise home_unit imp Nothing
- case mb_s of
- NotThere -> loopImports ss done summarised
- External uid -> do
- -- Pass an updated hsc_env to loopUnit, as each unit might
- -- have a different visible package database.
- let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env
- let done' = loopUnit hsc_env' done [uid]
- (other_deps, done'', summarised') <- loopImports ss done' summarised
- return (mkModuleEdge lvl (NodeKey_ExternalUnit uid) : other_deps, done'', summarised')
- FoundInstantiation iud -> do
- (other_deps, done', summarised') <- loopImports ss done summarised
- return (mkModuleEdge lvl (NodeKey_Unit iud) : other_deps, done', summarised')
- FoundHomeWithError (_uid, e) -> loopImports ss done (Map.insert cache_key [(Left e)] summarised)
- FoundHome s -> do
- (done', summarised') <-
- loopModuleNodeInfo s (done, Map.insert cache_key [Right s] summarised)
- (other_deps, final_done, final_summarised) <- loopImports ss done' summarised'
-
- -- MP: This assumes that we can only instantiate non home units, which is probably fair enough for now.
- return (mkModuleEdge lvl (NodeKey_Module (mnKey s)) : other_deps, final_done, final_summarised)
- where
- UnresolvedImport { ui_level = lvl, ui_pkg_qual = mb_pkg
- , ui_boot = is_boot, ui_mod_name = wanted_mod } = imp
- cache_key = (home_uid, mb_pkg, GWIB (unLoc wanted_mod) is_boot)
-
-loopUnit :: HscEnv -> Map.Map NodeKey ModuleGraphNode -> [UnitId] -> Map.Map NodeKey ModuleGraphNode
-loopUnit _ cache [] = cache
-loopUnit lcl_hsc_env cache (u:uxs) = do
- let nk = (NodeKey_ExternalUnit u)
- case Map.lookup nk cache of
- Just {} -> loopUnit lcl_hsc_env cache uxs
- Nothing -> case unitDepends <$> lookupUnitId (hsc_units lcl_hsc_env) u of
- Just us -> loopUnit lcl_hsc_env (loopUnit lcl_hsc_env (Map.insert nk (UnitNode us u) cache) us) uxs
- Nothing -> pprPanic "loopUnit" (text "Malformed package database, missing " <+> ppr u)
-
-multiRootsErr :: SourceErrorContext -> [ModuleNodeInfo] -> IO ()
-multiRootsErr _ [] = panic "multiRootsErr"
-multiRootsErr sec summs@(summ1:_)
+ DownsweepEnv hsc_env mode summaries_cache_ref imports_cache_ref excl_mods <- ask
+ liftIO $ case mode of
+ DownsweepUseCompile ->
+ summariseModule hsc_env home_unit summaries_cache_ref imports_cache_ref
+ imp maybe_buf excl_mods
+ DownsweepUseFixed ->
+ summariseModuleInterface hsc_env home_unit imports_cache_ref imp excl_mods
+
+multiRootsErr :: SourceErrorContext -> NE.NonEmpty ModuleNodeInfo -> IO ()
+multiRootsErr sec (summ1 NE.:| summs)
= throwOneError sec $ fmap GhcDriverMessage $
mkPlainErrorMsgEnvelope noSrcSpan $ DriverDuplicatedModuleDeclaration mod files
where
mod = moduleNodeInfoModule summ1
- files = mapMaybe (ml_hs_file . moduleNodeInfoLocation) summs
+ files = mapMaybe (ml_hs_file . moduleNodeInfoLocation) (summ1:summs)
moduleNotFoundErr :: UnitId -> ModuleName -> DriverMessages
moduleNotFoundErr uid mod = singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverModuleNotFound uid mod)
@@ -696,48 +844,20 @@ instantiationNodes uid unit_state = map (uid,) iuids_to_check
, recur <- (indef :) $ goUnitId $ moduleUnit $ snd inst
]
--- The linking plan for each module. If we need to do linking for a home unit
--- then this function returns a graph node which depends on all the modules in the home unit.
-
--- At the moment nothing can depend on these LinkNodes.
-linkNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> Maybe (Either (Messages DriverMessage) ModuleGraphNode)
-linkNodes summaries uid hue =
- let dflags = homeUnitEnv_dflags hue
- ofile = outputFile_ dflags
-
- unit_nodes :: [NodeKey]
- unit_nodes = map mkNodeKey (filter ((== uid) . mgNodeUnitId) summaries)
- -- Issue a warning for the confusing case where the user
- -- said '-o foo' but we're not going to do any linking.
- -- We attempt linking if either (a) one of the modules is
- -- called Main, or (b) the user said -no-hs-main, indicating
- -- that main() is going to come from somewhere else.
- --
- no_hs_main = gopt Opt_NoHsMain dflags
-
- main_sum = any (== NodeKey_Module (ModNodeKeyWithUid (GWIB (mainModuleNameIs dflags) NotBoot) uid)) unit_nodes
-
- do_linking = main_sum || no_hs_main || ghcLink dflags == LinkDynLib || ghcLink dflags == LinkStaticLib || ghcLink dflags == LinkBytecodeLib
-
- in if | isExecutableLink (ghcLink dflags) && isJust ofile && not do_linking ->
- Just (Left $ singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverRedirectedNoMain $ mainModuleNameIs dflags))
- -- This should be an error, not a warning (#10895).
- | ghcLink dflags /= NoLink, do_linking -> Just (Right (LinkNode unit_nodes uid))
- | otherwise -> Nothing
-
getRootSummary ::
[ModuleName] ->
- M.Map (UnitId, OsPath) ModSummary ->
+ ModSummaryCache ->
+ ImportsCache ->
HscEnv ->
Target ->
IO (Either DriverMessages ModSummary)
-getRootSummary excl_mods old_summary_map hsc_env target
+getRootSummary excl_mods summ_cache imports_cache hsc_env target
| TargetFile file mb_phase <- targetId
= do
let offset_file = augmentByWorkingDirectory dflags file
exists <- liftIO $ doesFileExist offset_file
if exists || isJust maybe_buf
- then summariseFile hsc_env home_unit old_summary_map offset_file mb_phase
+ then summariseFile hsc_env home_unit summ_cache offset_file mb_phase
maybe_buf
else
return $ Left $ singleMessage $
@@ -746,7 +866,7 @@ getRootSummary excl_mods old_summary_map hsc_env target
= do
let root_imp = (generatedImport FromTarget (L rootLoc modl))
{ ui_pkg_qual = ThisPkg (homeUnitId home_unit) }
- maybe_summary <- summariseModule hsc_env home_unit old_summary_map root_imp
+ maybe_summary <- summariseModule hsc_env home_unit summ_cache imports_cache root_imp
maybe_buf excl_mods
pure case maybe_summary of
FoundHome (ModuleNodeCompile s) -> Right s
@@ -809,6 +929,10 @@ rootSummariesParallel n_jobs hsc_env diag_wrapper msg get_summary = do
throwIO e
a -> pure a
+--------------------------------------------------------------------------------
+-- * Check/validate properties and error out
+--------------------------------------------------------------------------------
+
-- | This function checks then important property that if both p and q are home units
-- then any dependency of p, which transitively depends on q is also a home unit.
--
@@ -856,6 +980,10 @@ checkHomeUnitsClosed ue
let todo'' = (depends Set.\\ done) `Set.union` todo'
in DigraphNode uid uid (Set.toList depends) : go (Set.insert uid done) todo''
+--------------------------------------------------------------------------------
+-- * Enable Code Gen for Template Haskell
+--------------------------------------------------------------------------------
+
-- | Update the every ModSummary that is depended on
-- by a module that needs template haskell. We enable codegen to
-- the specified target, disable optimization and change the .hi
@@ -1173,15 +1301,9 @@ Potential TODOS:
generating temporary ones.
-}
--- | Populate the Downsweep cache with the root modules.
-mkRootMap
- :: [ModuleNodeInfo]
- -> DownsweepCache
-mkRootMap summaries = Map.fromListWith (flip (++))
- [ ((moduleNodeInfoUnitId s, NoPkgQual, moduleNodeInfoMnwib s), [Right s]) | s <- summaries ]
-
-----------------------------------------------------------------------------
--- Summarising modules
+-- * Pre-processing and Summarising and modules
+-----------------------------------------------------------------------------
-- We have two types of summarisation:
--
@@ -1196,33 +1318,39 @@ mkRootMap summaries = Map.fromListWith (flip (++))
summariseFile
:: HscEnv
-> HomeUnit
- -> M.Map (UnitId, OsPath) ModSummary -- old summaries
+ -> ModSummaryCache
-> FilePath -- source file name
-> Maybe Phase -- start phase
-> Maybe (StringBuffer,UTCTime)
-> IO (Either DriverMessages ModSummary)
-summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
- -- we can use a cached summary if one is available and the
- -- source file hasn't changed,
- | Just old_summary <- M.lookup (homeUnitId home_unit, src_fn_os) old_summaries
- = do
- let location = ms_location $ old_summary
-
- src_hash <- get_src_hash
- -- The file exists; we checked in getRootSummary above.
- -- If it gets removed subsequently, then this
- -- getFileHash may fail, but that's the right
- -- behaviour.
-
- -- return the cached summary if the source didn't change
- checkSummaryHash
- hsc_env (new_summary src_fn)
- old_summary location src_hash
-
- | otherwise
- = do src_hash <- get_src_hash
- new_summary src_fn src_hash
+summariseFile hsc_env' home_unit summ_cache_ref src_fn mb_phase maybe_buf
+ = do file_summ_cache <- readIORef summ_cache_ref
+ case M.lookup (homeUnitId home_unit, src_fn_os) file_summ_cache of
+ Just (Right (chd_summary, SummFresh)) ->
+ -- Fresh: use it straight away
+ pure (Right chd_summary)
+ Just (Right (old_summary, SummOld)) -> do
+ -- we can use a cached summary if one is available and the
+ -- source file hasn't changed,
+ let location = ms_location $ old_summary
+
+ src_hash <- get_src_hash
+ -- The file exists; we checked in getRootSummary above.
+ -- If it gets removed subsequently, then this
+ -- getFileHash may fail, but that's the right
+ -- behaviour.
+
+ -- return the cached summary if the source didn't change
+ res <- checkSummaryHash
+ hsc_env (new_summary src_fn)
+ old_summary location src_hash
+ case res of
+ Right ms -> modifySummCache summ_cache_ref (addModSummaryCache ms SummFresh)
+ Left _ -> pure ()
+ return res
+ _ -> do src_hash <- get_src_hash
+ new_summary src_fn src_hash
where
-- change the main active unit so all operations happen relative to the given unit
hsc_env = hscSetActiveHomeUnit home_unit hsc_env'
@@ -1233,7 +1361,8 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
Just (buf,_) -> return $ fingerprintStringBuffer buf
Nothing -> liftIO $ getFileHash src_fn
- new_summary src_fn src_hash = runExceptT $ do
+ new_summary src_fn src_hash = do
+ res <- runExceptT $ do
preimps@PreprocessedImports {..}
<- getPreprocessedImports hsc_env src_fn mb_phase maybe_buf
@@ -1264,6 +1393,10 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
, nms_mod = mod
, nms_preimps = preimps
}
+ modifySummCache summ_cache_ref $ case res of
+ Left e -> M.insert (homeUnitId home_unit, src_fn_os) (Left e)
+ Right ms -> addModSummaryCache ms SummFresh
+ return res
checkSummaryHash
:: HscEnv
@@ -1316,13 +1449,14 @@ data SummariseResult =
-- --make mode.
summariseModule :: HscEnv
-> HomeUnit
- -> M.Map (UnitId, OsPath) ModSummary
+ -> ModSummaryCache
+ -> ImportsCache
-> UnresolvedImport PkgQual -- ^ The import being summarised
-> Maybe (StringBuffer, UTCTime)
-> [ModuleName]
-> IO SummariseResult
-summariseModule hsc_env home_unit old_summaries imp maybe_buf excl_mods =
- summariseModuleDispatch k hsc_env home_unit imp excl_mods
+summariseModule hsc_env home_unit old_summaries imps_cache imp maybe_buf excl_mods =
+ summariseModuleDispatch k hsc_env imps_cache home_unit imp excl_mods
where
k = summariseModuleWithSource home_unit old_summaries (ui_boot imp) maybe_buf
@@ -1331,11 +1465,12 @@ summariseModule hsc_env home_unit old_summaries imp maybe_buf excl_mods =
-- This version always returns a ModuleNodeFixed node.
summariseModuleInterface :: HscEnv
-> HomeUnit
+ -> ImportsCache
-> UnresolvedImport PkgQual -- ^ The import being summarised
-> [ModuleName]
-> IO SummariseResult
-summariseModuleInterface hsc_env home_unit imp excl_mods =
- summariseModuleDispatch k hsc_env home_unit imp excl_mods
+summariseModuleInterface hsc_env home_unit imps_cache imp excl_mods =
+ summariseModuleDispatch k hsc_env imps_cache home_unit imp excl_mods
where
k _hsc_env loc mod = do
-- The finder will return a path to the .hi-boot even if it doesn't actually
@@ -1352,129 +1487,167 @@ summariseModuleInterface hsc_env home_unit imp excl_mods =
summariseModuleDispatch
:: (HscEnv -> ModLocation -> Module -> IO SummariseResult) -- ^ Continuation about how to summarise a home module.
-> HscEnv
+ -> ImportsCache
-> HomeUnit
-> UnresolvedImport PkgQual -- ^ The import being summarised
-> [ModuleName] -- Modules to exclude
-> IO SummariseResult
-summariseModuleDispatch k hsc_env' home_unit imp excl_mods
- | wanted_mod `elem` excl_mods
+summariseModuleDispatch k hsc_env' imps_cache_ref home_unit imp excl_mods
+ | unLoc wanted_mod `elem` excl_mods
= return NotThere
| otherwise = find_it
where
- wanted_mod = unLoc (ui_mod_name imp)
-
-- Temporarily change the currently active home unit so all operations
-- happen relative to it
hsc_env = hscSetActiveHomeUnit home_unit hsc_env'
find_it :: IO SummariseResult
find_it = do
- found <- resolveImport hsc_env imp
- case found of
- Found location mod
- | moduleUnitId mod `Set.member` hsc_all_home_unit_ids hsc_env ->
- -- Home package
- k hsc_env location mod
- | VirtUnit iud <- moduleUnit mod
- , not (isHomeModule home_unit mod)
- -> return $ FoundInstantiation iud
- | otherwise -> return $ External (moduleUnitId mod)
- _ -> return NotThere
- -- Not found
- -- (If it is TRULY not found at all, we'll
- -- error when we actually try to compile)
-
+ imps_cache <- readIORef imps_cache_ref
+ case M.lookup cache_key imps_cache of
+ Just result -> return result
+ Nothing -> do
+ found <- resolveImport hsc_env imp
+ r <- case found of
+ Found location mod
+ | moduleUnitId mod `Set.member` hsc_all_home_unit_ids hsc_env ->
+ -- Home package
+ k hsc_env location mod
+ | VirtUnit iud <- moduleUnit mod
+ , not (isHomeModule home_unit mod)
+ -> return $ FoundInstantiation iud
+ | otherwise -> return $ External (moduleUnitId mod)
+ _ -> return NotThere
+ -- Not found
+ -- (If it is TRULY not found at all, we'll
+ -- error when we actually try to compile)
+ modifyImpsCache imps_cache_ref (M.insert cache_key r)
+ return r
+
+ UnresolvedImport { ui_pkg_qual = mb_pkg, ui_boot = is_boot
+ , ui_mod_name = wanted_mod } = imp
+ cache_key = ( homeUnitId home_unit, mb_pkg
+ , GWIB{ gwib_mod = unLoc wanted_mod, gwib_isBoot = is_boot })
-- | The continuation to summarise a home module if we want to find the source file
-- for it and potentially compile it.
summariseModuleWithSource
:: HomeUnit
- -> M.Map (UnitId, OsPath) ModSummary
- -- ^ Map of old summaries
+ -> ModSummaryCache
+ -- ^ Cache of constructed summaries
-> IsBootInterface -- True <=> a {-# SOURCE #-} import
-> Maybe (StringBuffer, UTCTime)
-> HscEnv
-> ModLocation
-> Module
-> IO SummariseResult
-summariseModuleWithSource home_unit old_summary_map is_boot maybe_buf hsc_env location mod = do
- -- Adjust location to point to the hs-boot source file,
- -- hi file, object file, when is_boot says so
- let src_fn = expectJust (ml_hs_file location)
-
- -- Check that it exists
- -- It might have been deleted since the Finder last found it
+summariseModuleWithSource home_unit summ_cache_ref is_boot maybe_buf hsc_env location mod = do
+ -- Adjust location to point to the hs-boot source file,
+ -- hi file, object file, when is_boot says so
+ let src_fn = expectJust (ml_hs_file location)
+ summ_cache <- readIORef summ_cache_ref
+
+ -- Reject the cache result if the module name doesn't match the inferred
+ -- module name based on the file name.
+ -- See (W1) in Note [Downsweep Control Flow and Caching]
+ let cached = do
+ p <- ml_hs_file_ospath location
+ res <- M.lookup (moduleUnitId mod, p) summ_cache
+ case res of
+ Right (ms, _) | msKey ms /= moduleToMnk mod is_boot ->
+ -- Module name doesn't match the file path name.
+ -- We fall through to @new_summary@, where this will be
+ -- discovered and the correct error message will be thrown.
+ Nothing
+ _ -> Just res
+
+ case cached of
+ Just (Right (chd_summary, SummFresh)) ->
+ -- Fresh! just return it
+ pure $ FoundHome (ModuleNodeCompile chd_summary)
+
+ Just (Left err) ->
+ -- Failure, don't try to summarise it again
+ pure $ FoundHomeWithError (moduleUnitId mod, err)
+
+ mb_old -> do
+ -- Either Nothing or a potentially old summary, must check.
+
+ -- Check that it exists
+ -- It might have been deleted since the Finder last found it
maybe_h <- fileHashIfExists src_fn
case maybe_h of
-- This situation can also happen if we have found the .hs file but the
-- .hs-boot file doesn't exist.
Nothing -> return NotThere
Just h -> do
- fresult <- new_summary_cache_check location mod src_fn h
+ fresult <- case mb_old of
+ Just (Right (old_summary, SummOld)) ->
+ -- check the hash on the source file, and return the cached
+ -- summary if it hasn't changed. If the file has changed then
+ -- need to resummarise.
+ case maybe_buf of
+ Just (buf,_) ->
+ checkSummaryHash hsc_env (new_summary location mod src_fn) old_summary location (fingerprintStringBuffer buf)
+ Nothing ->
+ checkSummaryHash hsc_env (new_summary location mod src_fn) old_summary location h
+ Nothing ->
+ new_summary location mod src_fn h
return $ case fresult of
Left err -> FoundHomeWithError (moduleUnitId mod, err)
Right ms -> FoundHome (ModuleNodeCompile ms)
-
where
dflags = hsc_dflags hsc_env
- new_summary_cache_check loc mod src_fn h
- | Just old_summary <- Map.lookup ((toUnitId (moduleUnit mod), src_fn_os)) old_summary_map =
-
- -- check the hash on the source file, and
- -- return the cached summary if it hasn't changed. If the
- -- file has changed then need to resummarise.
- case maybe_buf of
- Just (buf,_) ->
- checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc (fingerprintStringBuffer buf)
- Nothing ->
- checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc h
- | otherwise = new_summary loc mod src_fn h
- where
- src_fn_os = unsafeEncodeUtf src_fn
-
new_summary :: ModLocation
-> Module
-> FilePath
-> Fingerprint
-> IO (Either DriverMessages ModSummary)
new_summary location mod src_fn src_hash
- = runExceptT $ do
- preimps@PreprocessedImports {..}
- -- Remember to set the active unit here, otherwise the wrong include paths are passed to CPP
- -- See multiHomeUnits_cpp2 test
- <- getPreprocessedImports (hscSetActiveUnitId (moduleUnitId mod) hsc_env) src_fn Nothing maybe_buf
-
- -- NB: Despite the fact that is_boot is a top-level parameter, we
- -- don't actually know coming into this function what the HscSource
- -- of the module in question is. This is because we may be processing
- -- this module because another module in the graph imported it: in this
- -- case, we know if it's a boot or not because of the {-# SOURCE #-}
- -- annotation, but we don't know if it's a signature or a regular
- -- module until we actually look it up on the filesystem.
- let hsc_src
- | is_boot == IsBoot = HsBootFile
- | isHaskellSigFilename src_fn = HsigFile
- | otherwise = HsSrcFile
-
- when (pi_mod_name /= moduleName mod) $
- throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
- $ DriverFileModuleNameMismatch pi_mod_name (moduleName mod)
-
- let instantiations = homeUnitInstantiations home_unit
- when (hsc_src == HsigFile && isNothing (lookup pi_mod_name instantiations)) $
- throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
- $ DriverUnexpectedSignature pi_mod_name (checkBuildingCabalPackage dflags) instantiations
-
- liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary
- { nms_src_fn = src_fn
- , nms_src_hash = src_hash
- , nms_hsc_src = hsc_src
- , nms_location = location
- , nms_mod = mod
- , nms_preimps = preimps
- }
+ = do
+ res <- runExceptT $ do
+ preimps@PreprocessedImports {..}
+ -- Remember to set the active unit here, otherwise the wrong include paths are passed to CPP
+ -- See multiHomeUnits_cpp2 test
+ <- getPreprocessedImports (hscSetActiveUnitId (moduleUnitId mod) hsc_env) src_fn Nothing maybe_buf
+
+ -- NB: Despite the fact that is_boot is a top-level parameter, we
+ -- don't actually know coming into this function what the HscSource
+ -- of the module in question is. This is because we may be processing
+ -- this module because another module in the graph imported it: in this
+ -- case, we know if it's a boot or not because of the {-# SOURCE #-}
+ -- annotation, but we don't know if it's a signature or a regular
+ -- module until we actually look it up on the filesystem.
+ let hsc_src
+ | is_boot == IsBoot = HsBootFile
+ | isHaskellSigFilename src_fn = HsigFile
+ | otherwise = HsSrcFile
+
+ when (pi_mod_name /= moduleName mod) $
+ throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
+ $ DriverFileModuleNameMismatch pi_mod_name (moduleName mod)
+
+ let instantiations = homeUnitInstantiations home_unit
+ when (hsc_src == HsigFile && isNothing (lookup pi_mod_name instantiations)) $
+ throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
+ $ DriverUnexpectedSignature pi_mod_name (checkBuildingCabalPackage dflags) instantiations
+
+ liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary
+ { nms_src_fn = src_fn
+ , nms_src_hash = src_hash
+ , nms_hsc_src = hsc_src
+ , nms_location = location
+ , nms_mod = mod
+ , nms_preimps = preimps
+ }
+ modifySummCache summ_cache_ref $ case res of
+ Left e -> case ml_hs_file_ospath location of
+ Just p -> M.insert (moduleUnitId mod, p) (Left e)
+ Nothing -> id
+ Right ms -> addModSummaryCache ms SummFresh
+ return res
-- | Convenience named arguments for 'makeNewModSummary' only used to make
-- code more readable, not exported.
@@ -1497,7 +1670,6 @@ makeNewModSummary hsc_env MakeNewModSummary{..} = do
hie_timestamp <- modificationTimeIfExists (ml_hie_file_ospath nms_location)
bytecode_timestamp <- modificationTimeIfExists (ml_bytecode_file_ospath nms_location)
extra_sig_imports <- findExtraSigImports hsc_env nms_hsc_src pi_mod_name
- (implicit_sigs, _inst_deps) <- implicitRequirementsShallow (hscSetActiveUnitId (moduleUnitId nms_mod) hsc_env) pi_imps
return $
ModSummary
@@ -1510,7 +1682,6 @@ makeNewModSummary hsc_env MakeNewModSummary{..} = do
, ms_parsed_mod = Nothing
, ms_textual_imps =
(generatedImport FromBackpackSig . noLoc <$> extra_sig_imports) ++
- (generatedImport FromBackpackSig . noLoc <$> implicit_sigs) ++
pi_imps
, ms_hs_hash = nms_src_hash
, ms_iface_date = hi_timestamp
@@ -1549,3 +1720,160 @@ getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do
return (first (mkMessages . fmap mkDriverPsHeaderMessage . getMessages) mimps)
let pi_imps = map (rnUnresolvedImportPkgQual (renameRawPkgQual (hsc_unit_env hsc_env))) pi_imps'
return PreprocessedImports {..}
+
+--------------------------------------------------------------------------------
+-- * Generic traversal of iteratively-built graph: dfsBuild
+--------------------------------------------------------------------------------
+
+-- | The result of expanding a node in 'dfsBuild'.
+data NodeRes v
+ -- | Computed the node payload successfully
+ = NSuccess v
+ -- | Skip a node! This means this node doesn't produce a payload and we can
+ -- just ignore it if we ever come across it.
+ --
+ -- In practice, this might happen because of an error or maybe from an
+ -- attempt to expand e.g. an hs-boot node just to see if it sticks, but we
+ -- don't distinguish these uses. Skip just means ignore this node and don't
+ -- abort.
+ | NSkip
+
+-- | In a depth-first order, and starting from the given roots, traverse a
+-- graph by iteratively expanding a node into a payload and a list of children
+-- nodes to visit next.
+--
+-- A node is NEVER visited/expanded more than once, as long as the node key
+-- @k@, computed from the node @n@, uniquely identifies that node.
+--
+-- The first argument @base_map@ is the starting set of already visited nodes
+-- (these nodes won't be expanded again!).
+--
+-- The result is a mapping from the key of every node transitively reachable
+-- from the root nodes (inclusively) to the payload returned by expanding that
+-- node. The result includes the previously visited nodes given in @base_map@,
+-- s.t. @dfsBuild base_map [] _ _ == base_map@.
+--
+-- The @expand@ function returns an 'NResult'. See the 'NResult' documentation
+-- for more information about each result type.
+--
+-- Error handling and exiting early can be achieved by selecting a @Monad m@
+-- accordingly, such as @Control.Monad.Except.Except@
+--
+-- Example usage: @n@ is instanced to @DownsweepNode@, @k@ is @NodeKey@, and @v@ is @ModuleNodeEdge@.
+--
+-- See also Note [Downsweep Control Flow and Caching]
+dfsBuild :: (Ord k, Monad m)
+ => Maybe (Map.Map k (NodeRes v))
+ -- ^ Base map, existing results. We won't re-expand any of the nodes
+ -- already present in this map.
+ -> [n]
+ -- ^ The root nodes from where to start traversal
+ -> (n -> k)
+ -- ^ Compute the key which uniquely identifies this node
+ -> (n -> m (NodeRes (v,[n])))
+ -- ^ Expand this node into its payload result and into the list of
+ -- children nodes to visit next.
+ -> m (Map.Map k (NodeRes v))
+ -- ^ The result accumulates the payload of expanding the root nodes
+ -- and all nodes transitively reachable from those roots.
+dfsBuild base_map roots key expand = go roots (fromMaybe Map.empty base_map)
+ where
+ go [] visited = pure visited
+ go (s:ss) visited
+ | k `Map.member` visited
+ = go ss visited
+ | otherwise
+ = do r <- expand s
+ case r of
+ NSkip ->
+ go ss
+ (Map.insert k NSkip visited) -- Skip!
+ NSuccess (v,ns) ->
+ go (ns ++ ss)
+ (Map.insert k (NSuccess v) visited)
+ where
+ k = key s
+
+{-
+Note [Downsweep Control Flow and Caching]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The control flow of downsweep is extracted into a single function `dfsBuild`,
+which takes care of iteratively expanding and traversing all nodes of the
+in-construction module graph necessary to build a full `ModuleGraph` at the
+end.
+
+There are three levels of caching going on, all of which are necessary to make
+sure we don't do repeated work (notably, we NEVER summarise the same module
+twice).
+
+1. `dfsBuild` accumulates the final module graph and never revisits the
+ same node of the module graph. Cache is keyed by the final
+ `ModuleGraph`s `NodeKey`s.
+
+ For example, suppose
+
+ A imports B and C
+ B imports D
+ C imports D
+
+ Then, starting from A we will expand A and push B and C to the worklist;
+ then, going back to B, we expand B which pushes D to the worklist. After
+ processing D, we go to C, which imports D, but we have already visited that
+ module so we can just use the already-constructed `ModuleGraphNode` for D.
+
+2. For Module A in home-unit u1, each import in the list of imports
+ needs to be *found* (call to `findImportedModuleWithIsBoot`): at this
+ point, we only have the `ModuleName` of the import, not the `Module`.
+ This *finding* is somewhat expensive, so we cache it as well
+ (`ImportsCache`). The cache key is the home-unit to which the module
+ belongs~[1], the import package qualifier, and the ModuleName.
+
+ Same example, suppose
+
+ A imports B and C
+ B imports D
+ C imports D
+
+ When expanding B, we will findImportedModule "import D".
+ When expanding C, we would findImportedModule "import D", but we can just
+ look it up in the cache
+
+ [1] Different home-units will have different package flags, which means
+ potentially different `Module` resolution for the same `ModuleName`.
+
+3. The most expensive operation we want to avoid is summarising a
+ `Module` into a `ModSummary`, which notably involves parsing the
+ module header from scratch.
+ The third cache, in essence, maps a `Module` to its `ModSummary`
+ (named `ModSummaryCache`). This cache upholds the invariant: we NEVER
+ summarise the same module twice. In practice, the cache key is the
+ Module's UnitId and the Source path; the reason is we need to
+ distinguish between `.hs` and `.hs-boot` files, as their summaries
+ will differ.
+
+ Note that this covers more than just (1), because we summarise all imports
+ of a single module when expanding it (see 'expandModuleSummary'), before
+ returning from the expansion function.
+
+ Note that (2) can't guarantee this alone: Two ModuleName imports in
+ separate units can (and likely do) map to the same `Module`.
+
+(W1)
+ In `summariseModuleWithSource`, on a cache hit, we must check if the module
+ name matches the file name, because the cache might have been populated by
+ `summariseFile`:
+
+ - `summariseFile` is used for summarising file targets, where
+ the file name needn't match the module name: e.g., the `Main` module is
+ sometimes not defined in a file named `Main.hs`.
+
+ - `summariseModuleWithSource` is used for summarising module targets, like
+ an `import Bar`, where `Bar.hs` must contain `module Bar where`
+ specifically (since we will later look for .hi files based on the module
+ name).
+
+ See tests T27461a and T27461b.
+
+See also Note [Downsweep: building and maintaining the module graph] and
+Note [The ModuleGraph].
+-}
=====================================
compiler/GHC/Driver/Env.hs
=====================================
@@ -286,7 +286,7 @@ hugSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> UnitId -> Modu
-- These things are currently stored in the EPS for home packages. (See #25795 for
-- progress in removing these kind of checks; and making these functions of
-- `UnitEnv` rather than `HscEnv`)
--- See Note [Downsweep and the ModuleGraph]
+-- See Note [The ModuleGraph]
hugSomeThingsBelowUs _ _ hsc_env _ _ | isOneShot (ghcMode (hsc_dflags hsc_env)) = return []
hugSomeThingsBelowUs extract include_hi_boot hsc_env uid mn
= let hug = hsc_HUG hsc_env
=====================================
compiler/GHC/Tc/Utils/Backpack.hs
=====================================
@@ -292,28 +292,28 @@ implicitRequirements hsc_env normal_imports
where
mhome_unit = hsc_home_unit_maybe hsc_env
--- | Like @implicitRequirements'@, but returns either the module name, if it is
--- a free hole, or the instantiated unit the imported module is from, so that
--- that instantiated unit can be processed and via the batch mod graph (rather
--- than a transitive closure done here) all the free holes are still reachable.
+-- | Like @implicitRequirements'@, but returns the instantiated unit the
+-- imported module is from, so that that instantiated unit can be processed and
+-- via the batch mod graph (rather than a transitive closure done here) all the
+-- free holes are still reachable.
implicitRequirementsShallow
:: HscEnv
-> [UnresolvedImport PkgQual]
- -> IO ([ModuleName], [InstantiatedUnit])
-implicitRequirementsShallow hsc_env normal_imports = go ([], []) normal_imports
+ -> IO [InstantiatedUnit]
+implicitRequirementsShallow hsc_env normal_imports = go [] normal_imports
where
mhome_unit = hsc_home_unit_maybe hsc_env
go acc [] = pure acc
- go (accL, accR) (e:imports) = do
+ go accR (e:imports) = do
found <- resolveImport hsc_env e
let acc' = case found of
Found _ mod | notHomeModuleMaybe mhome_unit mod ->
case moduleUnit mod of
- HoleUnit -> (moduleName mod : accL, accR)
- RealUnit _ -> (accL, accR)
- VirtUnit u -> (accL, u:accR)
- _ -> (accL, accR)
+ HoleUnit -> panic "implicitRequirementsShallow: HoleUnit is unreachable through findImportedModule!"
+ RealUnit _ -> accR
+ VirtUnit u -> u:accR
+ _ -> accR
go acc' imports
-- | Given a 'Unit', make sure it is well typed. This is because
=====================================
compiler/GHC/Unit/Env.hs
=====================================
@@ -167,7 +167,7 @@ data UnitEnv = UnitEnv
, ue_module_graph :: ModuleGraph
-- ^ The module graph of the current session
- -- See Note [Downsweep and the ModuleGraph] for when this is constructed.
+ -- See Note [The ModuleGraph] for when this is constructed.
, ue_home_unit_graph :: !HomeUnitGraph
-- See Note [Multiple Home Units]
=====================================
hadrian/hie-bios.bat
=====================================
=====================================
testsuite/tests/driver/T27461/Main1.hs
=====================================
@@ -0,0 +1,6 @@
+module Main where
+
+import Bar () -- resolves to src/Bar.hs, which declares module Foo
+
+main :: IO ()
+main = return ()
=====================================
testsuite/tests/driver/T27461/Main2.hs
=====================================
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = return ()
=====================================
testsuite/tests/driver/T27461/Makefile
=====================================
@@ -0,0 +1,9 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+# src/Bar.hs declares module Foo, which is fine for a file target, but Main's
+# `import Bar` resolves to that same file and must be rejected.
+T27461a :
+ cp Main1.hs src/Main.hs
+ ! '$(TEST_HC)' $(TEST_HC_OPTS) --make -fno-code -v0 -isrc src/Main.hs src/Bar.hs
=====================================
testsuite/tests/driver/T27461/T27461a.stderr
=====================================
@@ -0,0 +1,4 @@
+src/Bar.hs:1:8: error: [GHC-28623]
+ File name does not match module name:
+ Saw : ‘Foo’
+ Expected: ‘Bar’
=====================================
testsuite/tests/driver/T27461/T27461b.script
=====================================
@@ -0,0 +1,7 @@
+"-- Successfully load modules if file target is not imported"
+:! cp Main2.hs src/Main.hs
+:load src/Main.hs src/Bar.hs
+main
+:! cp Main1.hs src/Main.hs
+"-- Crash on reload as we import a file target that has the wrong module name"
+:reload
=====================================
testsuite/tests/driver/T27461/T27461b.stderr
=====================================
@@ -0,0 +1,5 @@
+src/Bar.hs:1:8: error: [GHC-28623]
+ File name does not match module name:
+ Saw : ‘Foo’
+ Expected: ‘Bar’
+
=====================================
testsuite/tests/driver/T27461/T27461b.stdout
=====================================
@@ -0,0 +1,2 @@
+"-- Successfully load modules if file target is not imported"
+"-- Crash on reload as we import a file target that has the wrong module name"
=====================================
testsuite/tests/driver/T27461/all.T
=====================================
@@ -0,0 +1,3 @@
+test('T27461a', extra_files(['src/', 'Main1.hs']), makefile_test, [])
+test('T27461b', [extra_files(['src/', 'Main1.hs', 'Main2.hs']), extra_hc_opts('-isrc')],
+ ghci_script, ['T27461b.script'])
=====================================
testsuite/tests/driver/T27461/src/Bar.hs
=====================================
@@ -0,0 +1,5 @@
+module Foo where
+-- Named Bar.hs but declares module Foo: allowed for a file target.
+
+foo :: Int
+foo = 1
=====================================
testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
=====================================
@@ -24,6 +24,7 @@ import Control.Monad.Catch (handle, throwM)
import Control.Exception.Context
import GHC.Driver.MakeFile
import GHC.Utils.Outputable
+import Data.IORef (newIORef)
-- | Convert a ModuleNodeCompile to a ModuleNodeFixed
convertToFixed :: ModuleNodeInfo -> ModuleNodeInfo
convertToFixed (ModuleNodeCompile ms) =
@@ -151,5 +152,6 @@ main = do
getModSummaryFromTarget :: FilePath -> Ghc ModSummary
getModSummaryFromTarget file = do
hsc_env <- getSession
- Right ms <- liftIO $ summariseFile hsc_env (DefiniteHomeUnit mainUnitId Nothing) mempty file Nothing Nothing
+ summ_cache <- liftIO $ newIORef mempty
+ Right ms <- liftIO $ summariseFile hsc_env (DefiniteHomeUnit mainUnitId Nothing) summ_cache file Nothing Nothing
return ms
=====================================
testsuite/tests/ghc-api/fixed-nodes/InterfaceModuleGraph.hs
=====================================
@@ -16,6 +16,7 @@ import GHC.Types.SourceFile
import System.Environment
import Control.Monad (void, when)
import Data.Maybe (fromJust)
+import Data.IORef (newIORef)
import Control.Exception (ExceptionWithContext(..), SomeException)
import Control.Monad.Catch (handle, throwM)
import Control.Exception.Context
@@ -67,7 +68,9 @@ main = do
keyC = msKey msC
let mkGraph s = do
- ([], nodes) <- downsweepFromRootNodes hsc_env mempty Nothing [] True DownsweepUseFixed s []
+ summ_cache <- newIORef mempty
+ imps_cache <- newIORef mempty
+ ([], nodes) <- downsweepFromRootNodes hsc_env summ_cache imps_cache Nothing [] True DownsweepUseFixed s []
return $ mkModuleGraph nodes
graph <- liftIO $ mkGraph [ModuleNodeCompile msC]
@@ -98,5 +101,6 @@ main = do
getModSummaryFromTarget :: FilePath -> Ghc ModSummary
getModSummaryFromTarget file = do
hsc_env <- getSession
- Right ms <- liftIO $ summariseFile hsc_env (DefiniteHomeUnit mainUnitId Nothing) mempty file Nothing Nothing
+ summ_cache <- liftIO $ newIORef mempty
+ Right ms <- liftIO $ summariseFile hsc_env (DefiniteHomeUnit mainUnitId Nothing) summ_cache file Nothing Nothing
return ms
=====================================
testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
=====================================
@@ -23,6 +23,7 @@ import Control.Monad.Catch (handle, throwM)
import Control.Exception.Context
import GHC.Utils.Outputable
import Data.List
+import Data.IORef (newIORef)
-- | Convert a ModuleNodeCompile to a ModuleNodeFixed
convertToFixed :: ModuleNodeInfo -> ModuleNodeInfo
@@ -132,5 +133,6 @@ main = do
getModSummaryFromTarget :: FilePath -> Ghc ModSummary
getModSummaryFromTarget file = do
hsc_env <- getSession
- Right ms <- liftIO $ summariseFile hsc_env (DefiniteHomeUnit mainUnitId Nothing) mempty file Nothing Nothing
+ summ_cache <- liftIO $ newIORef mempty
+ Right ms <- liftIO $ summariseFile hsc_env (DefiniteHomeUnit mainUnitId Nothing) summ_cache file Nothing Nothing
return ms
=====================================
testsuite/tests/splice-imports/SI35.hs
=====================================
@@ -28,6 +28,7 @@ import GHC.Unit.Module.Stage
import GHC.Data.Graph.Directed.Reachability
import GHC.Utils.Trace
import GHC.Unit.Module.Graph
+import Data.IORef (newIORef)
main :: IO ()
main = do
@@ -75,5 +76,6 @@ main = do
getModSummaryFromTarget :: FilePath -> Ghc ModSummary
getModSummaryFromTarget file = do
hsc_env <- getSession
- Right ms <- liftIO $ summariseFile hsc_env (DefiniteHomeUnit mainUnitId Nothing) mempty file Nothing Nothing
+ summ_cache <- liftIO $ newIORef mempty
+ Right ms <- liftIO $ summariseFile hsc_env (DefiniteHomeUnit mainUnitId Nothing) summ_cache file Nothing Nothing
return ms
\ No newline at end of file
=====================================
utils/check-ppr/Main.hs
=====================================
@@ -18,6 +18,7 @@ import System.Environment( getArgs )
import System.Exit
import System.FilePath
import System.IO
+import Data.IORef
usage :: String
usage = unlines
@@ -85,7 +86,8 @@ parseOneFile libdir fileName = do
let dflags2 = dflags `gopt_set` Opt_KeepRawTokenStream
_ <- setSessionDynFlags dflags2
hsc_env <- getSession
- mms <- liftIO $ summariseFile hsc_env (hsc_home_unit hsc_env) mempty fileName Nothing Nothing
+ cache <- liftIO $ newIORef mempty
+ mms <- liftIO $ summariseFile hsc_env (hsc_home_unit hsc_env) cache fileName Nothing Nothing
case mms of
Left _err -> error "parseOneFile"
Right ms -> parseModule ms
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c4c556d5f92e16e8ef4ded842df93e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c4c556d5f92e16e8ef4ded842df93e…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/az/epa-tidy-locatedxxx-16] 11 commits: Major patch to re-engineer known-key names
by Alan Zimmerman (＠alanz) 14 Aug '26
by Alan Zimmerman (＠alanz) 14 Aug '26
14 Aug '26
Alan Zimmerman pushed to branch wip/az/epa-tidy-locatedxxx-16 at Glasgow Haskell Compiler / GHC
Commits:
e4cfaaa0 by Simon Peyton Jones at 2026-08-14T01:09:32+02:00
Major patch to re-engineer known-key names
This big patch implements the New Plan for known-key names,
described in #27013.
Read the big Note [Overview of known-key names] in GHC.Types.Name
Some things had to be reworked slightly to accomodate the new known-keys
design. A significant one was the generation of auxiliary KindRep
bindings, which was greatly simplified. Note [Grand plan for Typeable]
was updated accordingly. Another example: GHC.Internal.CString was
merged into GHC.Internal.Types.
Co-authored-by: Rodrigo Mesquita <rodrigo.m.mesquita(a)gmail.com>
The couple hundreds of hours spent here by Rodrigo were sponsored by Well-Typed
Metrics: compile_time/bytes allocated
-------------------------------------
Baseline
Test Metric value New value Change
------------------------------------------------------------------------------------------
MultiComponentModules100(normal) ghc/alloc 24,312,779,672 24,990,470,432 +2.8% BAD
MultiComponentModulesRecomp(normal) ghc/alloc 601,924,960 621,884,888 +3.3% BAD
MultiComponentModulesRecomp100(normal) ghc/alloc 11,884,065,432 12,531,373,704 +5.4% BAD
MultiLayerModules(normal) ghc/alloc 3,861,537,072 3,706,919,512 -4.0% GOOD
T13701(normal) ghc/alloc 3,517,246,392 3,237,179,616 -8.0% GOOD
T13820(normal) ghc/alloc 28,961,056 29,663,208 +2.4% BAD
T14697(normal) ghc/alloc 472,044,184 443,550,048 -6.0% GOOD
T18140(normal) ghc/alloc 47,905,664 49,115,808 +2.5% BAD
T4801(normal) ghc/alloc 269,339,096 263,432,040 -2.2% GOOD
T783(normal) ghc/alloc 341,112,672 333,339,952 -2.3% GOOD
hard_hole_fits(normal) ghc/alloc 222,164,728 213,433,808 -3.9% GOOD
mhu-perf(normal) ghc/alloc 49,011,440 46,706,280 -4.7% GOOD
geo. mean +0.1%
minimum -8.0%
maximum +5.4%
All performance regressions were investigated in depth. The surviving
ones:
- MultiComponentModules100, MultiComponentModulesRecomp100,
MultiComponentModulesRecomp regresses because existing bugs that make
an additional implicit edge do too much redundant work: #27053 and #27461
- T13820, T18140, T10547, T13035 regress because we load an additional
interface and associated Names for GHC.Essentials.
-------------------------
Metric Decrease:
MultiLayerModules
T13379
T13701
T14697
T26989
T4801
T783
T9961
hard_hole_fits
mhu-perf
size_hello_artifact
size_hello_obj
size_hello_unicode
Metric Increase:
LinkableUsage01
LinkableUsage02
MultiComponentModules100
MultiComponentModulesRecomp
MultiComponentModulesRecomp100
T10547
T13035
T13820
T18140
T18698a
T18698b
T20049
-------------------------
Bumps submodule binary
Closes #27013
- - - - -
61665e79 by sheaf at 2026-08-14T01:09:33+02:00
Allow GHC.Essentials to be hidden
This commit overhauls several aspects of the known entity handling,
in order to allow GHC.Essentials to be hidden without a proliferation
of special cases in the compiler.
The main contribution is to introduce the 'UnresolvedImport' datatype
which cleans up a lot of ad-hoc handling relating to 'ModSummary',
fixing #27603. This allows us to reduce duplication, e.g. by having
Backpack reuse 'mkUnresolvedImports' instead of replicating the
"add implicit imports" logic. It also makes it easier to avoid
undesirable edge cases (such as making sure that the Template Haskell
'reifyModule' function does not leak the implicit GHC.Essentials import).
In particular, the infamous 'findImportedModuleWithIsBoot' is now simply
'resolveImport', taking a single 'UnresolvedImport' and resolving it
to a 'FindResult' (usually a 'Module').
Other changes:
- Cache the result of looking up GHC.Essentials (in TcM and DsM
environments) to avoid redundant work.
This reduces allocations on LinkableUsage01 and hard_hole_fits.
- Properly look up known entities for StaticPointers like we do for
other known entities everywhere else. This allows e.g. modules in
ghc-internal to use -XStaticPointers.
- When using multiple home units, we are now careful to handle the
situation in which we may have multiple GHC.Essentials modules
around. See the new tests under 'driver/multipleHomeUnits'.
- - - - -
b19fcc1c by Vladislav Zavialov at 2026-08-14T06:26:11-04:00
Increase test coverage of diagnostics, batch 2
Add test cases for the previously untested diagnostics:
[GHC-26133] TcRnForeignImportPrimSafeAnn
[GHC-68444] SumAltArityExceeded
[GHC-63966] IllegalSumAlt
[GHC-23882] IllegalDeclaration
[GHC-60220] InvalidCCallImpent
[GHC-18816] RecGadtNoCons
[GHC-38140] GadtNoCons
[GHC-37056] InvalidTypeInstanceHeader
[GHC-78486] InvalidTyFamInstLHS
[GHC-39639] DefaultDataInstDecl
[GHC-78822] AssocDefaultNotAssoc
[GHC-43510] NotSimpleUnliftedType
[GHC-41843] IOResultExpected
[GHC-07641] AtLeastOneArgExpected
[GHC-52886] InvalidTopDecl
Remove unused error constructors:
[GHC-92057] ImportLookupAmbiguous
- - - - -
7b27f25a by Simon Jakobi at 2026-08-14T06:26:54-04:00
testsuite: Drop peak_megabytes_allocated from LinkableUsage tests
LinkableUsage01/02 collected all metrics with a 2% tolerance. For
peak_megabytes_allocated, whose granularity is 1 MB, that window is
under 0.7 MB at this test's ~34 MB peak, so any 1 MB step failed the
test (#27613, #27489). Drop that metric: max_bytes_used guards the
Linkable-retention property with byte granularity, at a tolerance
that still comfortably exceeds the noise observed in CI.
Assisted-by: Claude Fable 5
- - - - -
e5de423b by Simon Jakobi at 2026-08-14T06:26:54-04:00
testsuite: Don't truncate fractional baselines when computing bounds
RelativeMetricAcceptanceWindow.get_bounds truncated the baseline with
int() before applying the tolerance. Baselines can be fractional (they
are averaged over several measurements), so this skewed the acceptance
window downwards: in #27613, a baseline of 33.67 at 2% tolerance
yielded bounds (32, 34) instead of (32, 35), rejecting a measurement
that was within tolerance.
Assisted-by: Claude Fable 5
- - - - -
db959f83 by Simon Jakobi at 2026-08-14T15:16:44-04:00
testsuite: Expect length001 failure in nonmoving_thr_sanity
length001 relies on an optimization rule to avoid excessive stack use.
The nonmoving_thr_sanity way does not enable optimization, so classify
its stack overflow as an expected failure, as is already done for the
other unoptimized nonmoving ways.
Assisted-by: gpt-5.6-sol via Codex CLI
- - - - -
4f2b7d90 by Simon Jakobi at 2026-08-14T15:16:44-04:00
testsuite: Omit T22859 in nonmoving threaded ways
T22859 checks allocation-limit handlers with output that depends on
precise allocation behaviour. The nonmoving threaded ways change where
these limits are reached, just as the already-omitted LLVM ways do.
Omit these ways instead of treating their incidental output differences
as test failures.
Assisted-by: gpt-5.6-sol via Codex CLI
- - - - -
c4abddcb by Simon Jakobi at 2026-08-14T15:16:44-04:00
rts/js: Implement eq_thread, and test Eq/Ord ThreadId (#16761)
Since d1f3c63701, Eq ThreadId is implemented via the RTS function
eq_thread, but the JS RTS never provided it, so comparing ThreadIds
for equality on the JS backend crashed with
ReferenceError: h$eq_thread is not defined
Like the C implementation, h$eq_thread uses pointer equality: The JS
RTS has exactly one thread object per thread.
Since previously no test exercised eq_thread directly, this commit
adds a test covering equality, its stability across GC, and agreement
with Ord.
Assisted-by: Claude Fable 5
- - - - -
4a7defa1 by Simon Jakobi at 2026-08-14T15:16:44-04:00
testsuite: Make listThreads1 insensitive to the RTS's own threads
listThreads1 expected `listThreads` to return exactly [ThreadId 1]. That
holds only under a non-threaded RTS. Under a threaded RTS however there
are more threads present, so we change the test to simply check that
`myThreadId` is present in the list.
Assisted-by: Claude Opus 5
- - - - -
b757727a by Vladislav Zavialov at 2026-08-14T15:17:27-04:00
Fix tcLookupId panic with RequiredTypeArguments and PatternSynonyms (#27586)
The arguments declared on the left-hand side of a pattern synonym are looked up
as term variables bound by its right-hand side. Prior to this patch, that lookup
panicked with RequiredTypeArguments:
data T a where
MkT :: forall a -> T a
pattern P :: Int -> T Int
pattern P x = MkT x
On the RHS, `x` looks like a term argument, so the renamer binds it in the term
namespace. Only during type checking does it turn out to be a type variable, so
the lookup on the LHS finds an ATyVar rather than an ATcId. As the lookup was
done with tcLookupId, it resulted in a panic.
Now the arguments are looked up with tcLookupPatSynArg, which reports an illegal
term-level use of `x`, just as an ordinary function definition `f (MkT x) = x`
does.
Test cases: T27586a T27586b T27586c
Assisted-by: Claude Opus 5
- - - - -
69c393ef by Alan Zimmerman at 2026-08-14T21:30:48+01:00
EPA: Remove al_trailing from AnnList
It was not being used
- - - - -
854 changed files:
- + changelog.d/T27586
- + changelog.d/refactor-known-names
- compiler/GHC.hs
- + compiler/GHC/Builtin.hs
- + compiler/GHC/Builtin/KnownKeys.hs
- + compiler/GHC/Builtin/KnownOccs.hs
- + compiler/GHC/Builtin/Modules.hs
- − compiler/GHC/Builtin/Names.hs
- − compiler/GHC/Builtin/Names/TH.hs
- compiler/GHC/Builtin/PrimOps.hs
- compiler/GHC/Builtin/PrimOps/Casts.hs
- compiler/GHC/Builtin/PrimOps/Ids.hs
- + compiler/GHC/Builtin/TH.hs
- compiler/GHC/Builtin/Uniques.hs
- compiler/GHC/Builtin/Uniques.hs-boot
- − compiler/GHC/Builtin/Utils.hs
- + compiler/GHC/Builtin/WiredIn/Ids.hs
- compiler/GHC/Builtin/Types/Prim.hs → compiler/GHC/Builtin/WiredIn/Prim.hs
- compiler/GHC/Builtin/Types/Literals.hs → compiler/GHC/Builtin/WiredIn/TypeLits.hs
- compiler/GHC/Builtin/Types.hs → compiler/GHC/Builtin/WiredIn/Types.hs
- compiler/GHC/Builtin/Types.hs-boot → compiler/GHC/Builtin/WiredIn/Types.hs-boot
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Core/FVs.hs
- compiler/GHC/Core/FamInstEnv.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Make.hs
- compiler/GHC/Core/Multiplicity.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/Core/Opt/CprAnal.hs
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/LiberateCase.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- compiler/GHC/Core/Ppr.hs
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Core/Subst.hs
- compiler/GHC/Core/TyCo/FVs.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unfold.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Config/Tidy.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Driver/Env/KnotVars.hs
- compiler/GHC/Driver/Env/Types.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main/Hsc.hs
- compiler/GHC/Driver/Main/Passes.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/MakeFile.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Plugins.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/ImpExp.hs
- compiler/GHC/Hs/Lit.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Arrows.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Foreign/C.hs
- compiler/GHC/HsToCore/Foreign/Call.hs
- compiler/GHC/HsToCore/Foreign/JavaScript.hs
- compiler/GHC/HsToCore/Foreign/Utils.hs
- compiler/GHC/HsToCore/Foreign/Wasm.hs
- compiler/GHC/HsToCore/ListComp.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Pmc/Check.hs
- compiler/GHC/HsToCore/Pmc/Desugar.hs
- compiler/GHC/HsToCore/Pmc/Ppr.hs
- compiler/GHC/HsToCore/Pmc/Solver.hs
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Types.hs
- compiler/GHC/HsToCore/Usage.hs
- compiler/GHC/HsToCore/Utils.hs
- compiler/GHC/Iface/Binary.hs
- compiler/GHC/Iface/Env.hs
- − compiler/GHC/Iface/Env.hs-boot
- compiler/GHC/Iface/Errors/Ppr.hs
- compiler/GHC/Iface/Errors/Types.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Header.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Plugins.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Lit.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Rename/Unbound.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Runtime/Context.hs
- compiler/GHC/Runtime/Debugger.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Heap/Inspect.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/Runtime/Loader.hs
- compiler/GHC/Stg/BcPrep.hs
- compiler/GHC/Stg/Unarise.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm/Bind.hs
- compiler/GHC/StgToCmm/DataCon.hs
- compiler/GHC/StgToCmm/Env.hs
- compiler/GHC/StgToCmm/Foreign.hs
- compiler/GHC/StgToCmm/Lit.hs
- compiler/GHC/StgToCmm/Ticky.hs
- compiler/GHC/StgToJS/Apply.hs
- compiler/GHC/StgToJS/Arg.hs
- compiler/GHC/StgToJS/Expr.hs
- compiler/GHC/StgToJS/FFI.hs
- compiler/GHC/StgToJS/Linker/Utils.hs
- compiler/GHC/StgToJS/Utils.hs
- compiler/GHC/Tc/Deriv.hs
- compiler/GHC/Tc/Deriv/Functor.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- compiler/GHC/Tc/Deriv/Generics.hs
- compiler/GHC/Tc/Deriv/Infer.hs
- compiler/GHC/Tc/Deriv/Utils.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Hole.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Arrow.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Gen/Default.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Foreign.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Instance/FunDeps.hs
- compiler/GHC/Tc/Instance/Typeable.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Plugin.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/FunDeps.hs
- compiler/GHC/Tc/Solver/InertSet.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Rewrite.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Build.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Types/LclEnv.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/Tc/Utils/Concrete.hs
- compiler/GHC/Tc/Utils/Env.hs
- compiler/GHC/Tc/Utils/Instantiate.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Validity.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/DefaultEnv.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/Hint.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/Literal.hs
- compiler/GHC/Types/Name.hs
- compiler/GHC/Types/Name/Cache.hs
- compiler/GHC/Types/Name/Ppr.hs
- compiler/GHC/Types/Name/Reader.hs
- compiler/GHC/Types/RepType.hs
- compiler/GHC/Types/TyThing.hs
- compiler/GHC/Types/Unique.hs
- compiler/GHC/Types/Unique/FM.hs
- + compiler/GHC/Types/UnresolvedImport.hs
- compiler/GHC/Types/Var.hs
- compiler/GHC/Unit.hs
- compiler/GHC/Unit/External.hs
- compiler/GHC/Unit/External/Index.hs
- compiler/GHC/Unit/External/ModuleOrigin.hs
- compiler/GHC/Unit/External/Providers.hs
- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Finder/Types.hs
- compiler/GHC/Unit/Module/Deps.hs
- compiler/GHC/Unit/Module/ModSummary.hs
- compiler/GHC/Unit/State.hs
- compiler/GHC/Unit/Types.hs
- compiler/GHC/Utils/Binary.hs
- − compiler/GHC/Utils/Binary/Typeable.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/ghc.cabal.in
- docs/users_guide/separate_compilation.rst
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Monad.hs
- ghc/Main.hs
- libraries/base/base.cabal.in
- libraries/base/src/Control/Applicative.hs
- libraries/base/src/Control/Concurrent.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/Data.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/Data/Version.hs
- libraries/base/src/GHC/Base.hs
- libraries/base/src/GHC/ByteOrder.hs
- + libraries/base/src/GHC/Essentials.hs
- libraries/base/src/GHC/Exts.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/Numeric.hs
- libraries/base/src/Prelude.hs
- libraries/base/src/System/CPUTime/Posix/ClockGetTime.hsc
- libraries/base/src/System/CPUTime/Posix/RUsage.hsc
- libraries/base/src/System/CPUTime/Posix/Times.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/Info.hs
- libraries/base/src/System/Timeout.hs
- libraries/base/src/Text/Printf.hs
- libraries/base/src/Text/Read.hs
- libraries/base/src/Text/Show/Functions.hs
- libraries/base/tests/all.T
- libraries/base/tests/listThreads1.hs
- libraries/base/tests/listThreads1.stdout
- libraries/binary
- libraries/ghc-experimental/src/Data/Sum/Experimental.hs
- libraries/ghc-experimental/src/Data/Tuple/Experimental.hs
- libraries/ghc-experimental/src/GHC/Profiling/Eras.hs
- libraries/ghc-experimental/src/Prelude/Experimental.hs
- libraries/ghc-internal/codepages/MakeTable.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/include/RtsIfaceSymbols.h
- libraries/ghc-internal/src/GHC/Internal/AllocationLimitHandler.hs
- libraries/ghc-internal/src/GHC/Internal/Arr.hs
- libraries/ghc-internal/src/GHC/Internal/ArrayArray.hs
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Bignum/Backend.hs
- libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/GMP.hs
- libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Native.hs
- libraries/ghc-internal/src/GHC/Internal/Bignum/BigNat.hs
- libraries/ghc-internal/src/GHC/Internal/Bignum/BigNat.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs
- libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Bignum/Natural.hs
- libraries/ghc-internal/src/GHC/Internal/Bignum/Natural.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Bignum/Primitives.hs
- libraries/ghc-internal/src/GHC/Internal/Bignum/WordArray.hs
- libraries/ghc-internal/src/GHC/Internal/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs
- libraries/ghc-internal/src/GHC/Internal/CString.hs
- libraries/ghc-internal/src/GHC/Internal/Char.hs
- libraries/ghc-internal/src/GHC/Internal/Classes.hs
- libraries/ghc-internal/src/GHC/Internal/Classes/IP.hs
- libraries/ghc-internal/src/GHC/Internal/Clock.hsc
- libraries/ghc-internal/src/GHC/Internal/ClosureTypes.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Bound.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/POSIX.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/POSIX/Const.hsc
- libraries/ghc-internal/src/GHC/Internal/Conc/Signal.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs
- libraries/ghc-internal/src/GHC/Internal/ConsoleHandler.hsc
- libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Category.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Concurrent/MVar.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/IO/Class.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Lazy.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Lazy/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Zip.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Coerce.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Dynamic.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Either.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Foldable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Function.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Const.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Identity.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Utils.hs
- libraries/ghc-internal/src/GHC/Internal/Data/IORef.hs
- libraries/ghc-internal/src/GHC/Internal/Data/List.hs
- libraries/ghc-internal/src/GHC/Internal/Data/List/NonEmpty.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Maybe.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Monoid.hs
- libraries/ghc-internal/src/GHC/Internal/Data/NonEmpty.hs
- libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Ord.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Proxy.hs
- libraries/ghc-internal/src/GHC/Internal/Data/STRef.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Semigroup/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Data/String.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Traversable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Tuple.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Bool.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Coercion.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Equality.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Ord.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Typeable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Typeable/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Unique.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Void.hs
- libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs
- libraries/ghc-internal/src/GHC/Internal/Desugar.hs
- libraries/ghc-internal/src/GHC/Internal/Encoding/UTF8.hs
- libraries/ghc-internal/src/GHC/Internal/Enum.hs
- libraries/ghc-internal/src/GHC/Internal/Enum.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Environment.hs
- libraries/ghc-internal/src/GHC/Internal/Err.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Arr.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Array.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Control.hs
- libraries/ghc-internal/src/GHC/Internal/Event/EPoll.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/IntTable.hs
- libraries/ghc-internal/src/GHC/Internal/Event/IntVar.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Internal/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Event/KQueue.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Manager.hs
- libraries/ghc-internal/src/GHC/Internal/Event/PSQ.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Poll.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/Event/TimeOut.hs
- libraries/ghc-internal/src/GHC/Internal/Event/TimerManager.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Unique.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/Clock.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/ConsoleEvent.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/FFI.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/ManagedThreadPool.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Exception/Context.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Context.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs-boot
- libraries/ghc-internal/src/GHC/Internal/ExecutionStack.hs
- libraries/ghc-internal/src/GHC/Internal/ExecutionStack/Internal.hsc
- libraries/ghc-internal/src/GHC/Internal/Exts.hs
- libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs
- libraries/ghc-internal/src/GHC/Internal/Fingerprint/Type.hs
- libraries/ghc-internal/src/GHC/Internal/Float.hs
- libraries/ghc-internal/src/GHC/Internal/Float/ConversionUtils.hs
- libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/ConstPtr.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/Error.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/String.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/String/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/ForeignPtr/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Alloc.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Array.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Error.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Pool.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Utils.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Ptr.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Storable.hs
- libraries/ghc-internal/src/GHC/Internal/ForeignPtr.hs
- libraries/ghc-internal/src/GHC/Internal/ForeignSrcLang.hs
- libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs
- libraries/ghc-internal/src/GHC/Internal/GHCi.hs
- libraries/ghc-internal/src/GHC/Internal/GHCi/Helpers.hs
- libraries/ghc-internal/src/GHC/Internal/Generics.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/Constants.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable/Types.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTableProf.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/ProfInfo/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO.hs
- libraries/ghc-internal/src/GHC/Internal/IO.hs-boot
- libraries/ghc-internal/src/GHC/Internal/IO/Buffer.hs
- libraries/ghc-internal/src/GHC/Internal/IO/BufferedIO.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Device.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage/API.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/CodePage/Table.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Failure.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Iconv.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Latin1.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF16.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF32.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/UTF8.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs-boot
- libraries/ghc-internal/src/GHC/Internal/IO/FD.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/FD.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Internals.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Common.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Flock.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/NoOp.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Windows.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs-boot
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/IO/IOMode.hs
- libraries/ghc-internal/src/GHC/Internal/IO/SubSystem.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Unsafe.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Windows/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Windows/Handle.hsc
- libraries/ghc-internal/src/GHC/Internal/IOArray.hs
- libraries/ghc-internal/src/GHC/Internal/IORef.hs
- libraries/ghc-internal/src/GHC/Internal/InfoProv.hs
- libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc
- libraries/ghc-internal/src/GHC/Internal/Int.hs
- libraries/ghc-internal/src/GHC/Internal/IsList.hs
- libraries/ghc-internal/src/GHC/Internal/Ix.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Foreign/Callback.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Prim.hs
- libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs
- libraries/ghc-internal/src/GHC/Internal/Lexeme.hs
- libraries/ghc-internal/src/GHC/Internal/List.hs
- libraries/ghc-internal/src/GHC/Internal/MVar.hs
- libraries/ghc-internal/src/GHC/Internal/Magic.hs
- libraries/ghc-internal/src/GHC/Internal/Magic/Dict.hs
- libraries/ghc-internal/src/GHC/Internal/Maybe.hs
- libraries/ghc-internal/src/GHC/Internal/Num.hs
- libraries/ghc-internal/src/GHC/Internal/Num.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Numeric.hs
- libraries/ghc-internal/src/GHC/Internal/OverloadedLabels.hs
- libraries/ghc-internal/src/GHC/Internal/Pack.hs
- libraries/ghc-internal/src/GHC/Internal/Prim/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/Prim/Ext.hs
- libraries/ghc-internal/src/GHC/Internal/Prim/Panic.hs
- libraries/ghc-internal/src/GHC/Internal/Prim/PtrEq.hs
- libraries/ghc-internal/src/GHC/Internal/Profiling.hs
- libraries/ghc-internal/src/GHC/Internal/Ptr.hs
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc
- libraries/ghc-internal/src/GHC/Internal/Read.hs
- libraries/ghc-internal/src/GHC/Internal/Real.hs
- libraries/ghc-internal/src/GHC/Internal/Real.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Records.hs
- libraries/ghc-internal/src/GHC/Internal/ST.hs
- libraries/ghc-internal/src/GHC/Internal/STM.hs
- libraries/ghc-internal/src/GHC/Internal/STRef.hs
- libraries/ghc-internal/src/GHC/Internal/Show.hs
- libraries/ghc-internal/src/GHC/Internal/Stable.hs
- libraries/ghc-internal/src/GHC/Internal/StableName.hs
- libraries/ghc-internal/src/GHC/Internal/Stack.hs
- libraries/ghc-internal/src/GHC/Internal/Stack.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/Constants.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/ConstantsProf.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/Types.hs
- libraries/ghc-internal/src/GHC/Internal/StaticPtr.hs
- libraries/ghc-internal/src/GHC/Internal/StaticPtr/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Stats.hsc
- libraries/ghc-internal/src/GHC/Internal/Storable.hs
- libraries/ghc-internal/src/GHC/Internal/System/Environment.hs
- libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc
- libraries/ghc-internal/src/GHC/Internal/System/Environment/ExecutablePath.hsc
- libraries/ghc-internal/src/GHC/Internal/System/IO/Error.hs
- libraries/ghc-internal/src/GHC/Internal/System/Mem.hs
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Types.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
- libraries/ghc-internal/src/GHC/Internal/Text/ParserCombinators/ReadP.hs
- libraries/ghc-internal/src/GHC/Internal/Text/ParserCombinators/ReadPrec.hs
- libraries/ghc-internal/src/GHC/Internal/Text/Read/Lex.hs
- libraries/ghc-internal/src/GHC/Internal/TopHandler.hs
- libraries/ghc-internal/src/GHC/Internal/Tuple.hs
- libraries/ghc-internal/src/GHC/Internal/Type/Reflection.hs
- libraries/ghc-internal/src/GHC/Internal/Type/Reflection/Unsafe.hs
- libraries/ghc-internal/src/GHC/Internal/TypeError.hs
- libraries/ghc-internal/src/GHC/Internal/TypeLits.hs
- libraries/ghc-internal/src/GHC/Internal/TypeLits/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/TypeNats.hs
- libraries/ghc-internal/src/GHC/Internal/TypeNats/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/DerivedCoreProperties.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/GeneralCategory.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleLowerCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleTitleCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/SimpleUpperCaseMapping.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Version.hs
- libraries/ghc-internal/src/GHC/Internal/Unsafe/Coerce.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Conc.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Conc/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Exports.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Imports.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Weak.hs
- libraries/ghc-internal/src/GHC/Internal/Weak/Finalize.hs
- libraries/ghc-internal/src/GHC/Internal/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/Word.hs
- libraries/ghc-internal/tools/ucd2haskell/exe/UCD2Haskell/ModuleGenerators.hs
- libraries/ghc-prim/Dummy.hs
- libraries/ghc-prim/ghc-prim.cabal
- libraries/template-haskell/Language/Haskell/TH/Lib.hs
- linters/lint-codes/LintCodes/Static.hs
- rts/include/rts/RtsToHsIface.h
- rts/js/thread.js
- testsuite/driver/perf_notes.py
- testsuite/driver/testlib.py
- testsuite/driver/testutil.py
- testsuite/tests/ado/T13242a.stderr
- testsuite/tests/annotations/should_fail/annfail10.stderr
- testsuite/tests/backpack/cabal/bkpcabal07/Makefile
- testsuite/tests/backpack/should_compile/T20396.stderr
- testsuite/tests/backpack/should_fail/bkpfail17.stderr
- testsuite/tests/bytecode/TLinkable/all.T
- testsuite/tests/cabal/T12485/Makefile
- + testsuite/tests/cabal/T27013a/Makefile
- + testsuite/tests/cabal/T27013a/Setup.hs
- + testsuite/tests/cabal/T27013a/all.T
- + testsuite/tests/cabal/T27013a/composition.cabal
- + testsuite/tests/cabal/T27013a/src/Data/Composition.hs
- + testsuite/tests/cabal/T27013d/Composition.hs
- + testsuite/tests/cabal/T27013d/Makefile
- + testsuite/tests/cabal/T27013d/T27013d.stdout
- + testsuite/tests/cabal/T27013d/all.T
- testsuite/tests/callarity/unittest/CallArity1.hs
- + testsuite/tests/concurrent/should_run/T16761.hs
- + testsuite/tests/concurrent/should_run/T16761.stdout
- testsuite/tests/concurrent/should_run/all.T
- testsuite/tests/corelint/LintEtaExpand.hs
- testsuite/tests/corelint/T21115b.stderr
- testsuite/tests/corelint/T27374.hs
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/deSugar/should_compile/T13208.stdout
- testsuite/tests/deSugar/should_compile/T16615.stderr
- testsuite/tests/deSugar/should_compile/T2431.stderr
- testsuite/tests/default/DefaultImportFail01.stderr
- testsuite/tests/default/DefaultImportFail02.stderr
- testsuite/tests/default/DefaultImportFail03.stderr
- testsuite/tests/default/DefaultImportFail04.stderr
- testsuite/tests/default/DefaultImportFail05.stderr
- testsuite/tests/default/DefaultImportFail07.stderr
- testsuite/tests/default/T25775.stderr
- testsuite/tests/deriving/should_compile/T14682.stderr
- testsuite/tests/deriving/should_compile/T20496.stderr
- testsuite/tests/diagnostic-codes/codes.stdout
- + testsuite/tests/driver/T27013b/Makefile
- + testsuite/tests/driver/T27013b/T27013b.stdout
- + testsuite/tests/driver/T27013b/X.hs
- + testsuite/tests/driver/T27013b/all.T
- + testsuite/tests/driver/T27013c/Makefile
- + testsuite/tests/driver/T27013c/T27013c.stdout
- + testsuite/tests/driver/T27013c/X.hs
- + testsuite/tests/driver/T27013c/all.T
- + testsuite/tests/driver/T27013e/T27013e.hs
- + testsuite/tests/driver/T27013e/T27013e.stderr
- + testsuite/tests/driver/T27013e/all.T
- + testsuite/tests/driver/T27013f/T27013f.hs
- + testsuite/tests/driver/T27013f/T27013f.stderr
- + testsuite/tests/driver/T27013f/all.T
- + testsuite/tests/driver/T27013g/T27013g.hs
- + testsuite/tests/driver/T27013g/all.T
- + testsuite/tests/driver/T27013h/GHC/Essentials.hs
- + testsuite/tests/driver/T27013h/T27013h.stderr
- + testsuite/tests/driver/T27013h/all.T
- + testsuite/tests/driver/T27013h/unitT27013h
- + testsuite/tests/driver/T27013i/T27013i.hs
- + testsuite/tests/driver/T27013i/T27013i.stderr
- + testsuite/tests/driver/T27013i/all.T
- testsuite/tests/driver/T3007/A/Internal.hs
- testsuite/tests/driver/T3007/Makefile
- testsuite/tests/driver/make-prim/Makefile
- testsuite/tests/driver/multipleHomeUnits/Makefile
- testsuite/tests/driver/multipleHomeUnits/all.T
- + testsuite/tests/driver/multipleHomeUnits/essentials-home/GHC/Essentials.hs
- + testsuite/tests/driver/multipleHomeUnits/essentials-order-base/B.hs
- + testsuite/tests/driver/multipleHomeUnits/essentials-order-user/U.hs
- + testsuite/tests/driver/multipleHomeUnits/essentials-user/M.hs
- testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr
- + testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_essentials.stdout
- + testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_essentials_order.stderr
- + testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_essentials_recomp.stdout
- + testsuite/tests/driver/multipleHomeUnits/unitEssentialsHome
- + testsuite/tests/driver/multipleHomeUnits/unitEssentialsHomeHidden
- + testsuite/tests/driver/multipleHomeUnits/unitEssentialsOrderBase
- + testsuite/tests/driver/multipleHomeUnits/unitEssentialsOrderUser
- + testsuite/tests/driver/multipleHomeUnits/unitEssentialsUser
- + testsuite/tests/driver/multipleHomeUnits/unitEssentialsUserHidden
- testsuite/tests/driver/recomp24656/Makefile
- testsuite/tests/driver/recomp24656/recomp24656.stdout
- testsuite/tests/ffi/should_fail/all.T
- + testsuite/tests/ffi/should_fail/ccfail006.hs
- + testsuite/tests/ffi/should_fail/ccfail006.stderr
- + testsuite/tests/ffi/should_fail/ccfail007.hs
- + testsuite/tests/ffi/should_fail/ccfail007.stderr
- + testsuite/tests/ffi/should_fail/ccfail008.hs
- + testsuite/tests/ffi/should_fail/ccfail008.stderr
- + testsuite/tests/ffi/should_fail/ccfail009.hs
- + testsuite/tests/ffi/should_fail/ccfail009.stderr
- + testsuite/tests/ghc-api/EssentialsCoverage.hs
- testsuite/tests/ghc-api/T8628.hs
- testsuite/tests/ghc-api/all.T
- testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs
- testsuite/tests/ghc-api/exactprint/T22919.stderr
- testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
- testsuite/tests/ghci.debugger/scripts/break006.stderr
- testsuite/tests/ghci.debugger/scripts/print019.stderr
- testsuite/tests/ghci/scripts/ListTuplePunsPpr.stdout
- testsuite/tests/ghci/scripts/T4175.stdout
- testsuite/tests/ghci/scripts/all.T
- testsuite/tests/ghci/scripts/ghci064.stdout
- testsuite/tests/hiefile/should_run/T23120.stdout
- testsuite/tests/iface/IfaceSharingIfaceType.hs
- testsuite/tests/iface/IfaceSharingName.hs
- testsuite/tests/indexed-types/should_fail/T12522a.stderr
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/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/interface-stability/template-haskell-exports.stdout
- testsuite/tests/javascript/Makefile
- testsuite/tests/javascript/T24495.hs
- testsuite/tests/module/mod185.stderr
- testsuite/tests/numeric/should_compile/T14170.stdout
- testsuite/tests/numeric/should_compile/T14465.stdout
- testsuite/tests/numeric/should_compile/T7116.stdout
- testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr
- testsuite/tests/package/all.T
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
- testsuite/tests/parser/should_compile/KindSigs.stderr
- testsuite/tests/parser/should_compile/T14189.stderr
- testsuite/tests/parser/should_compile/T15279.stderr
- testsuite/tests/parser/should_compile/T20718.stderr
- testsuite/tests/parser/should_compile/T20846.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr
- testsuite/tests/parser/should_fail/T16270h.hs
- testsuite/tests/partial-sigs/should_fail/NamedWildcardsNotInMonotype.stderr
- testsuite/tests/patsyn/should_fail/T26465.stderr
- testsuite/tests/perf/should_run/ByteCodeAsm.hs
- testsuite/tests/plugins/defaulting-plugin/DefaultInterference.hs
- testsuite/tests/plugins/defaulting-plugin/DefaultInvalid.hs
- testsuite/tests/plugins/defaulting-plugin/DefaultMultiParam.hs
- testsuite/tests/plugins/plugins09.stdout
- testsuite/tests/plugins/plugins10.stdout
- testsuite/tests/plugins/plugins11.stdout
- testsuite/tests/plugins/simple-plugin/Simple/ReplacePlugin.hs
- testsuite/tests/plugins/static-plugins.stdout
- testsuite/tests/printer/Test20297.stdout
- testsuite/tests/printer/Test24533.stdout
- testsuite/tests/profiling/should_run/callstack001.stdout
- testsuite/tests/profiling/should_run/callstack002.stderr
- testsuite/tests/profiling/should_run/callstack002.stdout
- testsuite/tests/rename/should_compile/T3103/Foreign/Ptr.hs
- testsuite/tests/rename/should_compile/T3103/GHC/Base.lhs
- testsuite/tests/rename/should_compile/T3103/GHC/Word.hs
- testsuite/tests/rename/should_compile/T3103/test.T
- testsuite/tests/roles/should_compile/Roles1.stderr
- testsuite/tests/roles/should_compile/Roles13.stderr
- testsuite/tests/roles/should_compile/Roles14.stderr
- testsuite/tests/roles/should_compile/Roles2.stderr
- testsuite/tests/roles/should_compile/Roles3.stderr
- testsuite/tests/roles/should_compile/Roles4.stderr
- testsuite/tests/roles/should_compile/T8958.stderr
- testsuite/tests/rts/all.T
- testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr
- testsuite/tests/simplCore/should_compile/T13543.stderr
- testsuite/tests/simplCore/should_compile/T16038/T16038.stdout
- testsuite/tests/simplCore/should_compile/T3717.stderr
- testsuite/tests/simplCore/should_compile/T3772.stdout
- testsuite/tests/simplCore/should_compile/T4908.stderr
- testsuite/tests/simplCore/should_compile/T4930.stderr
- testsuite/tests/simplCore/should_compile/T7360.stderr
- testsuite/tests/simplCore/should_compile/T8274.stdout
- testsuite/tests/simplCore/should_compile/T9400.stderr
- testsuite/tests/simplCore/should_compile/noinline01.stderr
- testsuite/tests/simplCore/should_compile/par01.stderr
- testsuite/tests/simplCore/should_compile/rule2.stderr
- testsuite/tests/simplCore/should_compile/str-rules.hs
- testsuite/tests/tcplugins/ArgsPlugin.hs
- testsuite/tests/tcplugins/EmitWantedPlugin.hs
- testsuite/tests/tcplugins/RewritePlugin.hs
- testsuite/tests/tcplugins/T26395_Plugin.hs
- testsuite/tests/tcplugins/TyFamPlugin.hs
- + testsuite/tests/th/AssocDefaultNotAssoc.hs
- + testsuite/tests/th/AssocDefaultNotAssoc.stderr
- testsuite/tests/th/T14741.hs
- testsuite/tests/th/T21547.stderr
- testsuite/tests/th/T26568.stderr
- + testsuite/tests/th/T27013th.hs
- + testsuite/tests/th/TH_InvalidTopDecl.hs
- + testsuite/tests/th/TH_InvalidTopDecl.stderr
- testsuite/tests/th/TH_Roles2.stderr
- + testsuite/tests/th/TH_cvt_DefaultDataInstDecl.hs
- + testsuite/tests/th/TH_cvt_DefaultDataInstDecl.stderr
- + testsuite/tests/th/TH_cvt_GadtNoCons.hs
- + testsuite/tests/th/TH_cvt_GadtNoCons.stderr
- + testsuite/tests/th/TH_cvt_IllegalDeclaration.hs
- + testsuite/tests/th/TH_cvt_IllegalDeclaration.stderr
- + testsuite/tests/th/TH_cvt_IllegalSumAlt.hs
- + testsuite/tests/th/TH_cvt_IllegalSumAlt.stderr
- + testsuite/tests/th/TH_cvt_InvalidCCallImpent.hs
- + testsuite/tests/th/TH_cvt_InvalidCCallImpent.stderr
- + testsuite/tests/th/TH_cvt_InvalidTyFamInstLHS.hs
- + testsuite/tests/th/TH_cvt_InvalidTyFamInstLHS.stderr
- + testsuite/tests/th/TH_cvt_InvalidTypeInstanceHeader.hs
- + testsuite/tests/th/TH_cvt_InvalidTypeInstanceHeader.stderr
- + testsuite/tests/th/TH_cvt_RecGadtNoCons.hs
- + testsuite/tests/th/TH_cvt_RecGadtNoCons.stderr
- + testsuite/tests/th/TH_cvt_SumAltArityExceeded.hs
- + testsuite/tests/th/TH_cvt_SumAltArityExceeded.stderr
- + testsuite/tests/th/TH_pragmaSpecOld.hs
- + testsuite/tests/th/TH_pragmaSpecOld.stderr
- testsuite/tests/th/all.T
- testsuite/tests/typecheck/should_compile/T13032.stderr
- testsuite/tests/typecheck/should_compile/T14273.stderr
- testsuite/tests/typecheck/should_compile/T18406b.stderr
- testsuite/tests/typecheck/should_compile/T18529.stderr
- testsuite/tests/typecheck/should_compile/holes.stderr
- testsuite/tests/typecheck/should_compile/holes2.stderr
- testsuite/tests/typecheck/should_compile/holes3.stderr
- testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
- testsuite/tests/typecheck/should_fail/T12921.stderr
- testsuite/tests/typecheck/should_fail/T14884.stderr
- testsuite/tests/typecheck/should_fail/T15883b.stderr
- testsuite/tests/typecheck/should_fail/T15883c.stderr
- testsuite/tests/typecheck/should_fail/T15883d.stderr
- testsuite/tests/typecheck/should_fail/T21130.stderr
- testsuite/tests/typecheck/should_fail/T3323.stderr
- testsuite/tests/typecheck/should_fail/T5095.stderr
- testsuite/tests/typecheck/should_fail/T7279.stderr
- testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr
- testsuite/tests/typecheck/should_fail/TyAppPat_PatternBindingExistential.stderr
- testsuite/tests/typecheck/should_fail/tcfail072.stderr
- testsuite/tests/typecheck/should_fail/tcfail097.stderr
- testsuite/tests/typecheck/should_fail/tcfail133.stderr
- testsuite/tests/typecheck/should_run/T22510.stdout
- testsuite/tests/unboxedsums/UbxSumLevPoly.hs
- testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs
- + testsuite/tests/vdq-rta/should_fail/T27586a.hs
- + testsuite/tests/vdq-rta/should_fail/T27586a.stderr
- + testsuite/tests/vdq-rta/should_fail/T27586b.hs
- + testsuite/tests/vdq-rta/should_fail/T27586b.stderr
- + testsuite/tests/vdq-rta/should_fail/T27586c.hs
- + testsuite/tests/vdq-rta/should_fail/T27586c.stderr
- testsuite/tests/vdq-rta/should_fail/all.T
- testsuite/tests/warnings/should_compile/DerivingTypeable.stderr
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Main.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Utils.hs
- utils/genprimopcode/Main.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
- utils/haddock/haddock-api/src/Haddock/Interface.hs
- utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/823ed99daefeecdc0c71f06cae6aac…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/823ed99daefeecdc0c71f06cae6aac…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: testsuite: Expect length001 failure in nonmoving_thr_sanity
by Marge Bot (＠marge-bot) 14 Aug '26
by Marge Bot (＠marge-bot) 14 Aug '26
14 Aug '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
db959f83 by Simon Jakobi at 2026-08-14T15:16:44-04:00
testsuite: Expect length001 failure in nonmoving_thr_sanity
length001 relies on an optimization rule to avoid excessive stack use.
The nonmoving_thr_sanity way does not enable optimization, so classify
its stack overflow as an expected failure, as is already done for the
other unoptimized nonmoving ways.
Assisted-by: gpt-5.6-sol via Codex CLI
- - - - -
4f2b7d90 by Simon Jakobi at 2026-08-14T15:16:44-04:00
testsuite: Omit T22859 in nonmoving threaded ways
T22859 checks allocation-limit handlers with output that depends on
precise allocation behaviour. The nonmoving threaded ways change where
these limits are reached, just as the already-omitted LLVM ways do.
Omit these ways instead of treating their incidental output differences
as test failures.
Assisted-by: gpt-5.6-sol via Codex CLI
- - - - -
c4abddcb by Simon Jakobi at 2026-08-14T15:16:44-04:00
rts/js: Implement eq_thread, and test Eq/Ord ThreadId (#16761)
Since d1f3c63701, Eq ThreadId is implemented via the RTS function
eq_thread, but the JS RTS never provided it, so comparing ThreadIds
for equality on the JS backend crashed with
ReferenceError: h$eq_thread is not defined
Like the C implementation, h$eq_thread uses pointer equality: The JS
RTS has exactly one thread object per thread.
Since previously no test exercised eq_thread directly, this commit
adds a test covering equality, its stability across GC, and agreement
with Ord.
Assisted-by: Claude Fable 5
- - - - -
4a7defa1 by Simon Jakobi at 2026-08-14T15:16:44-04:00
testsuite: Make listThreads1 insensitive to the RTS's own threads
listThreads1 expected `listThreads` to return exactly [ThreadId 1]. That
holds only under a non-threaded RTS. Under a threaded RTS however there
are more threads present, so we change the test to simply check that
`myThreadId` is present in the list.
Assisted-by: Claude Opus 5
- - - - -
b757727a by Vladislav Zavialov at 2026-08-14T15:17:27-04:00
Fix tcLookupId panic with RequiredTypeArguments and PatternSynonyms (#27586)
The arguments declared on the left-hand side of a pattern synonym are looked up
as term variables bound by its right-hand side. Prior to this patch, that lookup
panicked with RequiredTypeArguments:
data T a where
MkT :: forall a -> T a
pattern P :: Int -> T Int
pattern P x = MkT x
On the RHS, `x` looks like a term argument, so the renamer binds it in the term
namespace. Only during type checking does it turn out to be a type variable, so
the lookup on the LHS finds an ATyVar rather than an ATcId. As the lookup was
done with tcLookupId, it resulted in a panic.
Now the arguments are looked up with tcLookupPatSynArg, which reports an illegal
term-level use of `x`, just as an ordinary function definition `f (MkT x) = x`
does.
Test cases: T27586a T27586b T27586c
Assisted-by: Claude Opus 5
- - - - -
25159d71 by Rodrigo Mesquita at 2026-08-14T15:49:00-04:00
loopImports: Don't dup ms_uid in summary imports
We were writing the ms_unitid of the mod summary with every single
import of that module
That complicated the code (as though the UnitId in that list could ever
be something else) and also allocates unnecessarily per every mod
import. Very slight allocation decrease measured locally in a few tests:
(MultiComponentModulesRecomp: -0.06%; MultiComponentModulesRecomp100: -0.05%)
Purely a clean up.
- - - - -
1e20aba7 by Rodrigo Mesquita at 2026-08-14T15:49:00-04:00
downsweep: make control flow simpler and cache correct
This refactor extracts the control flow of downsweep into a single
function `dfsBuild`, which takes care of iteratively expanding and
traversing all nodes of the in-construction module graph necessary to
build a full `ModuleGraph`.
There are three levels of caching going on, all of which are necessary
to make sure we don't do repeated work (notably, NEVER summarise the
same module twice).
1. `dfsBuild` accumulates the final module graph and never revisits the
same node of the module graph. Cache is keyed by the final
`ModuleGraph`s `NodeKey`s.
2. For Module A in home-unit u1, each import in the list of imports
needs to be *found* (call to `findImportedModuleWithIsBoot`): at this
point, we only have the `ModuleName` of the import, not the `Module`.
This *finding* is somewhat expensive, so we cache it as well
(`ImportsCache`). The cache key is the home-unit to which the module
belongs~[1], the import package qualifier, and the ModuleName.
[1] Different home-units will have different package flags, which means
potentially different `Module` resolution for the same `ModuleName`.
3. The most expensive operation we want to avoid is summarising a
`Module` into a `ModSummary`, which notably involves parsing the
module header from scratch.
The third cache, in essence, maps a `Module` to its `ModSummary`
(named `ModSummaryCache`). This cache upholds the invariant: we NEVER
summarise the same module twice. In practice, the cache key is the
Module's UnitId and the Source path; the reason is we need to
distinguish between `.hs` and `.hs-boot` files, as their summaries
will differ.
Note that (2) can't guarantee this alone: Two ModuleName imports in
separate units can (and likely do) map to the same `Module`.
Note that the previous implementation failed to achieve the
no-duplicate-work summarisation invariant, and we ended up doing a
quadratic amount of processing in scenarios like test
`MultiComponentModules100`.
See also Note [Downsweep Control Flow and Caching]
Fixes #27461
Perf changes:
MultiComponentModules(normal) ghc/alloc 2,097,389,264 1,992,186,736 -5.0% GOOD
MultiComponentModules100(normal) ghc/alloc 24,310,173,770 21,293,867,360 -12.4% GOOD
MultiComponentModulesRecomp(normal) ghc/alloc 602,761,394 498,543,984 -17.3% GOOD
MultiComponentModulesRecomp100(normal) ghc/alloc 11,885,968,240 8,895,404,864 -25.2% GOOD
-------------------------
Metric Decrease:
MultiComponentModules
MultiComponentModules100
MultiComponentModulesRecomp
MultiComponentModulesRecomp100
-------------------------
- - - - -
af6ce9c2 by Rodrigo Mesquita at 2026-08-14T15:49:00-04:00
implicitRequirementsShallow can never reach HoleUnit
findImportedModule will never return `HoleUnit` for a `ModuleName`
(a `HoleUnit` can only be found as a signature instantiation, never as a
directly *imported* thing)
Therefore, we can drop `[ModuleName]` returned by
`implicitRequirementsShallow`, which makes many things dead code.
Namely, the call to `implicitRequirementsShallow` from
GHC.Driver.Downsweep which was a performance bottleneck (for doing lots
of duplicate work in findImportedModule) is now entirely gone.
Fixes #27053
In an MR with this patch and the downsweep refactor (previous commit), CI says:
MultiComponentModules(normal) ghc/alloc 2,097,396,728 1,943,662,304 -7.3% GOOD
MultiComponentModules100(normal) ghc/alloc 24,310,182,136 17,227,574,440 -29.1% GOOD
MultiComponentModulesRecomp(normal) ghc/alloc 602,769,518 449,973,656 -25.3% GOOD
MultiComponentModulesRecomp100(normal) ghc/alloc 11,885,976,408 4,828,894,160 -59.4% GOOD
-------------------------
Metric Decrease:
MultiComponentModules
MultiComponentModules100
MultiComponentModulesRecomp
MultiComponentModulesRecomp100
-------------------------
- - - - -
86fa86b4 by Rodrigo Mesquita at 2026-08-14T15:49:00-04:00
downsweep: Cache negative results
When traversing a module graph structure, a uniquely identified node
should always expand to the same thing.
I don't see how visiting the same node which failed to be expanded a
first time would ever successfully expand the second time we try to
expand it (eg. when coming from a different edge to it -- it is still
the same node!). The node expansion is local, based just based on the
node itself, not on the path to get there.
Therefore, this patch removes the weird behavior and commentary of
`dfsBuild` wrt to `Nothing` not being cached and being potentially
expanded a second time around to something different, which was
misleading and, ultimately, incorrect.
Now, we have a `MGRes`, which is more explicit about a node being
Skipped just being a node that is ignored whenever it is found (and that
skip is cached) -- and we may want to do this due to failures or due to
just trying nodes which might not work on purpose, like hs-boots.
We uniformly cache positive and negative results and remove the
assumption that there might be an ordering in which the same node
visited at a later time might be expanded differently.
This makes it possible to traverse the module nodes in parallel without
a change in behavior, since there's no longer a hidden ordering
requirement.
- - - - -
7dc5cc06 by Rodrigo Mesquita at 2026-08-14T15:49:00-04:00
Organize and clean-up GHC.Driver.Downsweep
Simply some cosmetic changes, moving definitions around to structure the
module better into its relevant sections
(In go (ns ++ ss), it's not a problem to use ++ because it's a good
producer and we won't have to append fully before processing the next
item in go)
- - - - -
c4c556d5 by mangoiv at 2026-08-14T15:49:03-04:00
hadrian: set the executable bit for hie-bios.bat
- - - - -
38 changed files:
- + changelog.d/T27586
- + changelog.d/downsweep-refactor
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/Env.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/Unit/Env.hs
- hadrian/hie-bios.bat
- libraries/base/tests/all.T
- libraries/base/tests/listThreads1.hs
- libraries/base/tests/listThreads1.stdout
- rts/js/thread.js
- + testsuite/tests/concurrent/should_run/T16761.hs
- + testsuite/tests/concurrent/should_run/T16761.stdout
- testsuite/tests/concurrent/should_run/all.T
- + testsuite/tests/driver/T27461/Main1.hs
- + testsuite/tests/driver/T27461/Main2.hs
- + testsuite/tests/driver/T27461/Makefile
- + testsuite/tests/driver/T27461/T27461a.stderr
- + testsuite/tests/driver/T27461/T27461b.script
- + testsuite/tests/driver/T27461/T27461b.stderr
- + testsuite/tests/driver/T27461/T27461b.stdout
- + testsuite/tests/driver/T27461/all.T
- + testsuite/tests/driver/T27461/src/Bar.hs
- testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
- testsuite/tests/ghc-api/fixed-nodes/InterfaceModuleGraph.hs
- testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
- testsuite/tests/rts/all.T
- testsuite/tests/splice-imports/SI35.hs
- + testsuite/tests/vdq-rta/should_fail/T27586a.hs
- + testsuite/tests/vdq-rta/should_fail/T27586a.stderr
- + testsuite/tests/vdq-rta/should_fail/T27586b.hs
- + testsuite/tests/vdq-rta/should_fail/T27586b.stderr
- + testsuite/tests/vdq-rta/should_fail/T27586c.hs
- + testsuite/tests/vdq-rta/should_fail/T27586c.stderr
- testsuite/tests/vdq-rta/should_fail/all.T
- utils/check-ppr/Main.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d22fd7ec99f6fd335a28f368112c1b…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d22fd7ec99f6fd335a28f368112c1b…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][master] Fix tcLookupId panic with RequiredTypeArguments and PatternSynonyms (#27586)
by Marge Bot (＠marge-bot) 14 Aug '26
by Marge Bot (＠marge-bot) 14 Aug '26
14 Aug '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
b757727a by Vladislav Zavialov at 2026-08-14T15:17:27-04:00
Fix tcLookupId panic with RequiredTypeArguments and PatternSynonyms (#27586)
The arguments declared on the left-hand side of a pattern synonym are looked up
as term variables bound by its right-hand side. Prior to this patch, that lookup
panicked with RequiredTypeArguments:
data T a where
MkT :: forall a -> T a
pattern P :: Int -> T Int
pattern P x = MkT x
On the RHS, `x` looks like a term argument, so the renamer binds it in the term
namespace. Only during type checking does it turn out to be a type variable, so
the lookup on the LHS finds an ATyVar rather than an ATcId. As the lookup was
done with tcLookupId, it resulted in a panic.
Now the arguments are looked up with tcLookupPatSynArg, which reports an illegal
term-level use of `x`, just as an ordinary function definition `f (MkT x) = x`
does.
Test cases: T27586a T27586b T27586c
Assisted-by: Claude Opus 5
- - - - -
9 changed files:
- + changelog.d/T27586
- compiler/GHC/Tc/TyCl/PatSyn.hs
- + testsuite/tests/vdq-rta/should_fail/T27586a.hs
- + testsuite/tests/vdq-rta/should_fail/T27586a.stderr
- + testsuite/tests/vdq-rta/should_fail/T27586b.hs
- + testsuite/tests/vdq-rta/should_fail/T27586b.stderr
- + testsuite/tests/vdq-rta/should_fail/T27586c.hs
- + testsuite/tests/vdq-rta/should_fail/T27586c.stderr
- testsuite/tests/vdq-rta/should_fail/all.T
Changes:
=====================================
changelog.d/T27586
=====================================
@@ -0,0 +1,9 @@
+section: compiler
+issues: #27586
+mrs: !16440
+synopsis:
+ Fix a panic on a required type argument in a pattern synonym RHS
+description:
+ An argument of a pattern synonym that is matched against a required type
+ argument in the right-hand side no longer causes a panic; it is reported as
+ an illegal term-level use of a type variable.
=====================================
compiler/GHC/Tc/TyCl/PatSyn.hs
=====================================
@@ -137,7 +137,7 @@ tcInferPatSynDecl (PSB { psb_id = lname@(L _ name), psb_args = details
; (tclvl, wanted, ((lpat', args), pat_ty))
<- pushLevelAndCaptureConstraints $
tcInferPat FRRPatSynArg PatSynCtx lpat $
- mapM tcLookupId arg_names
+ mapM tcLookupPatSynArg arg_names
; let (ex_tvs, prov_dicts) = tcCollectEx lpat'
@@ -472,7 +472,7 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details
-- location to x's binding site in lpat, namely the 'x' in Just (x,True).
-- Else the error message location is wherever tcCheckPat finished,
-- namely the right-hand corner of the pattern
- do { arg_id <- tcLookupId arg_name
+ do { arg_id <- tcLookupPatSynArg arg_name
; wrap <- tcSubTypeSigma (OccurrenceOf (idName arg_id))
GenSigCtxt
(idType arg_id)
@@ -645,6 +645,19 @@ collectPatSynArgInfo details =
InfixCon _ name1 name2 -> (map unLoc [name1, name2], True)
RecCon _ names -> (map (unLoc . recordPatSynPatVar) names, False)
+-- | Look up the 'Id' bound by the pattern for a declared argument of a pattern
+-- synonym. With @RequiredTypeArguments@ the argument may turn out to be a type
+-- variable, e.g. @pattern P x = MkT x@ where the argument of @MkT@ is a required
+-- type argument; then we report an illegal term-level use of @x@ (#27586).
+tcLookupPatSynArg :: Name -> TcM Id
+tcLookupPatSynArg arg_name
+ = do { thing <- tcLookup arg_name
+ ; case thing of
+ ATcId { tct_id = id } -> return id
+ AGlobal (AnId id) -> return id
+ ATyVar {} -> failIllegalTyVar (noUserRdr arg_name)
+ _ -> pprPanic "tcLookupPatSynArg" (ppr arg_name) }
+
wrongNumberOfParmsErr :: Name -> Arity -> Arity -> TcM a
wrongNumberOfParmsErr name decl_arity missing
= failWithTc $ TcRnPatSynArityMismatch name decl_arity missing
=====================================
testsuite/tests/vdq-rta/should_fail/T27586a.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
+
+module T27586a where
+
+data T a where
+ MkT :: forall a -> T a
+
+pattern P :: Int -> T Int
+pattern P x = MkT x
=====================================
testsuite/tests/vdq-rta/should_fail/T27586a.stderr
=====================================
@@ -0,0 +1,5 @@
+T27586a.hs:9:19: error: [GHC-01928]
+ • Illegal term-level use of the type variable ‘x’
+ • bound at T27586a.hs:9:19
+ • In the declaration for pattern synonym ‘P’
+
=====================================
testsuite/tests/vdq-rta/should_fail/T27586b.hs
=====================================
@@ -0,0 +1,8 @@
+{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
+
+module T27586b where
+
+data T a where
+ MkT :: forall a -> T a
+
+pattern P x = MkT x
=====================================
testsuite/tests/vdq-rta/should_fail/T27586b.stderr
=====================================
@@ -0,0 +1,5 @@
+T27586b.hs:8:15: error: [GHC-01928]
+ • Illegal term-level use of the type variable ‘x’
+ • bound at T27586b.hs:8:19
+ • In the declaration for pattern synonym ‘P’
+
=====================================
testsuite/tests/vdq-rta/should_fail/T27586c.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
+
+module T27586c where
+
+data T a where
+ MkT :: forall a -> T a
+
+pattern P :: Int -> T Int
+pattern P x <- MkT x
=====================================
testsuite/tests/vdq-rta/should_fail/T27586c.stderr
=====================================
@@ -0,0 +1,5 @@
+T27586c.hs:9:20: error: [GHC-01928]
+ • Illegal term-level use of the type variable ‘x’
+ • bound at T27586c.hs:9:20
+ • In the declaration for pattern synonym ‘P’
+
=====================================
testsuite/tests/vdq-rta/should_fail/all.T
=====================================
@@ -35,3 +35,6 @@ test('T25127_fail_arity', normal, compile_fail, [''])
test('T27440e', normal, compile_fail, [''])
test('T27583f', normal, compile_fail, [''])
+test('T27586a', normal, compile_fail, [''])
+test('T27586b', normal, compile_fail, [''])
+test('T27586c', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b757727a78613e7437a713058c24b94…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b757727a78613e7437a713058c24b94…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][master] 4 commits: testsuite: Expect length001 failure in nonmoving_thr_sanity
by Marge Bot (＠marge-bot) 14 Aug '26
by Marge Bot (＠marge-bot) 14 Aug '26
14 Aug '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
db959f83 by Simon Jakobi at 2026-08-14T15:16:44-04:00
testsuite: Expect length001 failure in nonmoving_thr_sanity
length001 relies on an optimization rule to avoid excessive stack use.
The nonmoving_thr_sanity way does not enable optimization, so classify
its stack overflow as an expected failure, as is already done for the
other unoptimized nonmoving ways.
Assisted-by: gpt-5.6-sol via Codex CLI
- - - - -
4f2b7d90 by Simon Jakobi at 2026-08-14T15:16:44-04:00
testsuite: Omit T22859 in nonmoving threaded ways
T22859 checks allocation-limit handlers with output that depends on
precise allocation behaviour. The nonmoving threaded ways change where
these limits are reached, just as the already-omitted LLVM ways do.
Omit these ways instead of treating their incidental output differences
as test failures.
Assisted-by: gpt-5.6-sol via Codex CLI
- - - - -
c4abddcb by Simon Jakobi at 2026-08-14T15:16:44-04:00
rts/js: Implement eq_thread, and test Eq/Ord ThreadId (#16761)
Since d1f3c63701, Eq ThreadId is implemented via the RTS function
eq_thread, but the JS RTS never provided it, so comparing ThreadIds
for equality on the JS backend crashed with
ReferenceError: h$eq_thread is not defined
Like the C implementation, h$eq_thread uses pointer equality: The JS
RTS has exactly one thread object per thread.
Since previously no test exercised eq_thread directly, this commit
adds a test covering equality, its stability across GC, and agreement
with Ord.
Assisted-by: Claude Fable 5
- - - - -
4a7defa1 by Simon Jakobi at 2026-08-14T15:16:44-04:00
testsuite: Make listThreads1 insensitive to the RTS's own threads
listThreads1 expected `listThreads` to return exactly [ThreadId 1]. That
holds only under a non-threaded RTS. Under a threaded RTS however there
are more threads present, so we change the test to simply check that
`myThreadId` is present in the list.
Assisted-by: Claude Opus 5
- - - - -
8 changed files:
- libraries/base/tests/all.T
- libraries/base/tests/listThreads1.hs
- libraries/base/tests/listThreads1.stdout
- rts/js/thread.js
- + testsuite/tests/concurrent/should_run/T16761.hs
- + testsuite/tests/concurrent/should_run/T16761.stdout
- testsuite/tests/concurrent/should_run/all.T
- testsuite/tests/rts/all.T
Changes:
=====================================
libraries/base/tests/all.T
=====================================
@@ -80,7 +80,7 @@ test('length001',
# excessive amounts of stack space. So we specifically set a low
# stack limit and mark it as failing under a few conditions.
[extra_run_opts('+RTS -K8m -RTS'),
- expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc', 'ext-interp']),
+ expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_sanity', 'nonmoving_thr_ghc', 'ext-interp']),
# JS doesn't support stack limit so the test sometimes passes just fine. Therefore the test is
# marked as fragile.
when(js_arch(), fragile(22921))],
=====================================
libraries/base/tests/listThreads1.hs
=====================================
@@ -2,5 +2,10 @@ module Main where
import GHC.Conc.Sync
+-- Regression test for the JS backend's ListThreadsOp, which used to omit the
+-- running thread. Whatever other threads the RTS has is irrelevant here.
main :: IO ()
-main = listThreads >>= print
+main = do
+ tid <- myThreadId
+ ts <- listThreads
+ print (tid `elem` ts)
=====================================
libraries/base/tests/listThreads1.stdout
=====================================
@@ -1 +1 @@
-[ThreadId 1]
+True
=====================================
rts/js/thread.js
=====================================
@@ -110,6 +110,10 @@ function h$rts_getThreadId(t) { // returns a CULLong
RETURN_UBX_TUP2((t.tid / Math.pow(2,32))>>>0, (t.tid & 0xFFFFFFFF)>>>0);
}
+function h$eq_thread(t1,t2) {
+ return t1 === t2 ? 1 : 0;
+}
+
function h$cmp_thread(t1,t2) {
if(t1.tid < t2.tid) return -1;
if(t1.tid > t2.tid) return 1;
=====================================
testsuite/tests/concurrent/should_run/T16761.hs
=====================================
@@ -0,0 +1,25 @@
+-- Test that Eq ThreadId is based on thread identity (eq_thread),
+-- not on the numeric thread id, which may wrap around (#16761).
+module Main (main) where
+
+import Control.Concurrent
+import System.Mem (performGC)
+
+main :: IO ()
+main = do
+ t0 <- myThreadId
+ print (t0 == t0)
+
+ mv <- newEmptyMVar
+ _ <- forkIO (myThreadId >>= putMVar mv)
+ tChild <- takeMVar mv
+ print (t0 == tChild)
+ print (tChild == tChild)
+
+ -- Equality must be stable even after the GC moves the TSOs.
+ performGC
+ print (t0 == t0)
+
+ -- Ord must agree with Eq.
+ print (compare t0 tChild /= EQ)
+ print (compare t0 t0 == EQ)
=====================================
testsuite/tests/concurrent/should_run/T16761.stdout
=====================================
@@ -0,0 +1,6 @@
+True
+False
+True
+True
+True
+True
=====================================
testsuite/tests/concurrent/should_run/all.T
=====================================
@@ -310,6 +310,8 @@ test('hs_try_putmvar003',
# Check forkIO exception determinism under optimization
test('T13330', normal, compile_and_run, ['-O'])
+test('T16761', normal, compile_and_run, [''])
+
test('T26341', normal, compile_and_run, [''])
# Test EINTR for async I/O interrupted by an exception (#26341)
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -679,7 +679,7 @@ test('T22859',
[js_skip,
# This test is vulnerable to changes in allocation behaviour, so we disable it in some ways
when(arch('wasm32'), skip),
- omit_ways(llvm_ways)],
+ omit_ways(llvm_ways + ['nonmoving_thr', 'nonmoving_thr_sanity'])],
compile_and_run, ['-with-rtsopts -A8K'])
# These tests need access to the internal RTS headers.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e5de423b97cf3c0ab2bfc9aa979246…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e5de423b97cf3c0ab2bfc9aa979246…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: testsuite: Expect length001 failure in nonmoving_thr_sanity
by Marge Bot (＠marge-bot) 14 Aug '26
by Marge Bot (＠marge-bot) 14 Aug '26
14 Aug '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
53682431 by Simon Jakobi at 2026-08-14T11:46:25-04:00
testsuite: Expect length001 failure in nonmoving_thr_sanity
length001 relies on an optimization rule to avoid excessive stack use.
The nonmoving_thr_sanity way does not enable optimization, so classify
its stack overflow as an expected failure, as is already done for the
other unoptimized nonmoving ways.
Assisted-by: gpt-5.6-sol via Codex CLI
- - - - -
c08a77ff by Simon Jakobi at 2026-08-14T11:46:25-04:00
testsuite: Omit T22859 in nonmoving threaded ways
T22859 checks allocation-limit handlers with output that depends on
precise allocation behaviour. The nonmoving threaded ways change where
these limits are reached, just as the already-omitted LLVM ways do.
Omit these ways instead of treating their incidental output differences
as test failures.
Assisted-by: gpt-5.6-sol via Codex CLI
- - - - -
8c1a9eab by Simon Jakobi at 2026-08-14T11:46:25-04:00
rts/js: Implement eq_thread, and test Eq/Ord ThreadId (#16761)
Since d1f3c63701, Eq ThreadId is implemented via the RTS function
eq_thread, but the JS RTS never provided it, so comparing ThreadIds
for equality on the JS backend crashed with
ReferenceError: h$eq_thread is not defined
Like the C implementation, h$eq_thread uses pointer equality: The JS
RTS has exactly one thread object per thread.
Since previously no test exercised eq_thread directly, this commit
adds a test covering equality, its stability across GC, and agreement
with Ord.
Assisted-by: Claude Fable 5
- - - - -
1a2b95ef by Simon Jakobi at 2026-08-14T11:46:25-04:00
testsuite: Make listThreads1 insensitive to the RTS's own threads
listThreads1 expected `listThreads` to return exactly [ThreadId 1]. That
holds only under a non-threaded RTS. Under a threaded RTS however there
are more threads present, so we change the test to simply check that
`myThreadId` is present in the list.
Assisted-by: Claude Opus 5
- - - - -
d22fd7ec by Vladislav Zavialov at 2026-08-14T11:46:27-04:00
Fix tcLookupId panic with RequiredTypeArguments and PatternSynonyms (#27586)
The arguments declared on the left-hand side of a pattern synonym are looked up
as term variables bound by its right-hand side. Prior to this patch, that lookup
panicked with RequiredTypeArguments:
data T a where
MkT :: forall a -> T a
pattern P :: Int -> T Int
pattern P x = MkT x
On the RHS, `x` looks like a term argument, so the renamer binds it in the term
namespace. Only during type checking does it turn out to be a type variable, so
the lookup on the LHS finds an ATyVar rather than an ATcId. As the lookup was
done with tcLookupId, it resulted in a panic.
Now the arguments are looked up with tcLookupPatSynArg, which reports an illegal
term-level use of `x`, just as an ordinary function definition `f (MkT x) = x`
does.
Test cases: T27586a T27586b T27586c
Assisted-by: Claude Opus 5
- - - - -
17 changed files:
- + changelog.d/T27586
- compiler/GHC/Tc/TyCl/PatSyn.hs
- libraries/base/tests/all.T
- libraries/base/tests/listThreads1.hs
- libraries/base/tests/listThreads1.stdout
- rts/js/thread.js
- + testsuite/tests/concurrent/should_run/T16761.hs
- + testsuite/tests/concurrent/should_run/T16761.stdout
- testsuite/tests/concurrent/should_run/all.T
- testsuite/tests/rts/all.T
- + testsuite/tests/vdq-rta/should_fail/T27586a.hs
- + testsuite/tests/vdq-rta/should_fail/T27586a.stderr
- + testsuite/tests/vdq-rta/should_fail/T27586b.hs
- + testsuite/tests/vdq-rta/should_fail/T27586b.stderr
- + testsuite/tests/vdq-rta/should_fail/T27586c.hs
- + testsuite/tests/vdq-rta/should_fail/T27586c.stderr
- testsuite/tests/vdq-rta/should_fail/all.T
Changes:
=====================================
changelog.d/T27586
=====================================
@@ -0,0 +1,9 @@
+section: compiler
+issues: #27586
+mrs: !16440
+synopsis:
+ Fix a panic on a required type argument in a pattern synonym RHS
+description:
+ An argument of a pattern synonym that is matched against a required type
+ argument in the right-hand side no longer causes a panic; it is reported as
+ an illegal term-level use of a type variable.
=====================================
compiler/GHC/Tc/TyCl/PatSyn.hs
=====================================
@@ -137,7 +137,7 @@ tcInferPatSynDecl (PSB { psb_id = lname@(L _ name), psb_args = details
; (tclvl, wanted, ((lpat', args), pat_ty))
<- pushLevelAndCaptureConstraints $
tcInferPat FRRPatSynArg PatSynCtx lpat $
- mapM tcLookupId arg_names
+ mapM tcLookupPatSynArg arg_names
; let (ex_tvs, prov_dicts) = tcCollectEx lpat'
@@ -472,7 +472,7 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details
-- location to x's binding site in lpat, namely the 'x' in Just (x,True).
-- Else the error message location is wherever tcCheckPat finished,
-- namely the right-hand corner of the pattern
- do { arg_id <- tcLookupId arg_name
+ do { arg_id <- tcLookupPatSynArg arg_name
; wrap <- tcSubTypeSigma (OccurrenceOf (idName arg_id))
GenSigCtxt
(idType arg_id)
@@ -645,6 +645,19 @@ collectPatSynArgInfo details =
InfixCon _ name1 name2 -> (map unLoc [name1, name2], True)
RecCon _ names -> (map (unLoc . recordPatSynPatVar) names, False)
+-- | Look up the 'Id' bound by the pattern for a declared argument of a pattern
+-- synonym. With @RequiredTypeArguments@ the argument may turn out to be a type
+-- variable, e.g. @pattern P x = MkT x@ where the argument of @MkT@ is a required
+-- type argument; then we report an illegal term-level use of @x@ (#27586).
+tcLookupPatSynArg :: Name -> TcM Id
+tcLookupPatSynArg arg_name
+ = do { thing <- tcLookup arg_name
+ ; case thing of
+ ATcId { tct_id = id } -> return id
+ AGlobal (AnId id) -> return id
+ ATyVar {} -> failIllegalTyVar (noUserRdr arg_name)
+ _ -> pprPanic "tcLookupPatSynArg" (ppr arg_name) }
+
wrongNumberOfParmsErr :: Name -> Arity -> Arity -> TcM a
wrongNumberOfParmsErr name decl_arity missing
= failWithTc $ TcRnPatSynArityMismatch name decl_arity missing
=====================================
libraries/base/tests/all.T
=====================================
@@ -80,7 +80,7 @@ test('length001',
# excessive amounts of stack space. So we specifically set a low
# stack limit and mark it as failing under a few conditions.
[extra_run_opts('+RTS -K8m -RTS'),
- expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc', 'ext-interp']),
+ expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_sanity', 'nonmoving_thr_ghc', 'ext-interp']),
# JS doesn't support stack limit so the test sometimes passes just fine. Therefore the test is
# marked as fragile.
when(js_arch(), fragile(22921))],
=====================================
libraries/base/tests/listThreads1.hs
=====================================
@@ -2,5 +2,10 @@ module Main where
import GHC.Conc.Sync
+-- Regression test for the JS backend's ListThreadsOp, which used to omit the
+-- running thread. Whatever other threads the RTS has is irrelevant here.
main :: IO ()
-main = listThreads >>= print
+main = do
+ tid <- myThreadId
+ ts <- listThreads
+ print (tid `elem` ts)
=====================================
libraries/base/tests/listThreads1.stdout
=====================================
@@ -1 +1 @@
-[ThreadId 1]
+True
=====================================
rts/js/thread.js
=====================================
@@ -110,6 +110,10 @@ function h$rts_getThreadId(t) { // returns a CULLong
RETURN_UBX_TUP2((t.tid / Math.pow(2,32))>>>0, (t.tid & 0xFFFFFFFF)>>>0);
}
+function h$eq_thread(t1,t2) {
+ return t1 === t2 ? 1 : 0;
+}
+
function h$cmp_thread(t1,t2) {
if(t1.tid < t2.tid) return -1;
if(t1.tid > t2.tid) return 1;
=====================================
testsuite/tests/concurrent/should_run/T16761.hs
=====================================
@@ -0,0 +1,25 @@
+-- Test that Eq ThreadId is based on thread identity (eq_thread),
+-- not on the numeric thread id, which may wrap around (#16761).
+module Main (main) where
+
+import Control.Concurrent
+import System.Mem (performGC)
+
+main :: IO ()
+main = do
+ t0 <- myThreadId
+ print (t0 == t0)
+
+ mv <- newEmptyMVar
+ _ <- forkIO (myThreadId >>= putMVar mv)
+ tChild <- takeMVar mv
+ print (t0 == tChild)
+ print (tChild == tChild)
+
+ -- Equality must be stable even after the GC moves the TSOs.
+ performGC
+ print (t0 == t0)
+
+ -- Ord must agree with Eq.
+ print (compare t0 tChild /= EQ)
+ print (compare t0 t0 == EQ)
=====================================
testsuite/tests/concurrent/should_run/T16761.stdout
=====================================
@@ -0,0 +1,6 @@
+True
+False
+True
+True
+True
+True
=====================================
testsuite/tests/concurrent/should_run/all.T
=====================================
@@ -310,6 +310,8 @@ test('hs_try_putmvar003',
# Check forkIO exception determinism under optimization
test('T13330', normal, compile_and_run, ['-O'])
+test('T16761', normal, compile_and_run, [''])
+
test('T26341', normal, compile_and_run, [''])
# Test EINTR for async I/O interrupted by an exception (#26341)
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -679,7 +679,7 @@ test('T22859',
[js_skip,
# This test is vulnerable to changes in allocation behaviour, so we disable it in some ways
when(arch('wasm32'), skip),
- omit_ways(llvm_ways)],
+ omit_ways(llvm_ways + ['nonmoving_thr', 'nonmoving_thr_sanity'])],
compile_and_run, ['-with-rtsopts -A8K'])
# These tests need access to the internal RTS headers.
=====================================
testsuite/tests/vdq-rta/should_fail/T27586a.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
+
+module T27586a where
+
+data T a where
+ MkT :: forall a -> T a
+
+pattern P :: Int -> T Int
+pattern P x = MkT x
=====================================
testsuite/tests/vdq-rta/should_fail/T27586a.stderr
=====================================
@@ -0,0 +1,5 @@
+T27586a.hs:9:19: error: [GHC-01928]
+ • Illegal term-level use of the type variable ‘x’
+ • bound at T27586a.hs:9:19
+ • In the declaration for pattern synonym ‘P’
+
=====================================
testsuite/tests/vdq-rta/should_fail/T27586b.hs
=====================================
@@ -0,0 +1,8 @@
+{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
+
+module T27586b where
+
+data T a where
+ MkT :: forall a -> T a
+
+pattern P x = MkT x
=====================================
testsuite/tests/vdq-rta/should_fail/T27586b.stderr
=====================================
@@ -0,0 +1,5 @@
+T27586b.hs:8:15: error: [GHC-01928]
+ • Illegal term-level use of the type variable ‘x’
+ • bound at T27586b.hs:8:19
+ • In the declaration for pattern synonym ‘P’
+
=====================================
testsuite/tests/vdq-rta/should_fail/T27586c.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
+
+module T27586c where
+
+data T a where
+ MkT :: forall a -> T a
+
+pattern P :: Int -> T Int
+pattern P x <- MkT x
=====================================
testsuite/tests/vdq-rta/should_fail/T27586c.stderr
=====================================
@@ -0,0 +1,5 @@
+T27586c.hs:9:20: error: [GHC-01928]
+ • Illegal term-level use of the type variable ‘x’
+ • bound at T27586c.hs:9:20
+ • In the declaration for pattern synonym ‘P’
+
=====================================
testsuite/tests/vdq-rta/should_fail/all.T
=====================================
@@ -35,3 +35,6 @@ test('T25127_fail_arity', normal, compile_fail, [''])
test('T27440e', normal, compile_fail, [''])
test('T27583f', normal, compile_fail, [''])
+test('T27586a', normal, compile_fail, [''])
+test('T27586b', normal, compile_fail, [''])
+test('T27586c', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/418e821bc2c9e4287c6495abd9856a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/418e821bc2c9e4287c6495abd9856a…
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help
1
0