[Git][ghc/ghc][wip/ghci-force-background] 3 commits: hackage-doc-tarball: Allow ghc-boot-th to be uploaded to hackage
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Mon Feb 3 13:13:17 UTC 2025
Matthew Pickering pushed to branch wip/ghci-force-background at Glasgow Haskell Compiler / GHC
Commits:
7bfc93a7 by Zubin Duggal at 2025-01-29T21:41:17-05:00
hackage-doc-tarball: Allow ghc-boot-th to be uploaded to hackage
It can't refer to files outside its source directory, so patch that part out.
This is OK because those files are only used while bootstrapping.
Also add ghci to the list of packages to be uploaded
Fixes #25687
- - - - -
704eeb02 by Roman S at 2025-01-29T21:42:05-05:00
Fix Control.Arrow (***) diagram (fixes #25698)
- - - - -
49afe39e by Matthew Pickering at 2025-02-03T13:12:51+00:00
ghci: Force bytecode to be evaluated after loading
Behaviour before: Bytecode is forced when you need it to evaluate an
expression in the interpreter.
Behaviour after: Bytecode is forced in parallel, in the background, after
the initial load is completed.
The goal is to increase percieved responsiveness of the interpreter
after a reload. If you do a reload and at a later point perform
evaluation, now the evaluation will start immediately, rather than
waiting first for all the byte code to be compiled.
Since the bytecode is evaluated in the background, the prompt can still
be used like normal to evaluate expressions or perform other queries.
2 * NUM_CAPABILITIES worker threads are spawned. The work to evaluate
the unforced bytecode is queued in a TChan which is then read by the
worker threads.
- - - - -
8 changed files:
- .gitlab/rel_eng/upload_ghc_libs.py
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Unit/Home/PackageTable.hs
- compiler/GHC/Utils/Trace.hs
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Monad.hs
- ghc/ghc-bin.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs
Changes:
=====================================
.gitlab/rel_eng/upload_ghc_libs.py
=====================================
@@ -93,6 +93,11 @@ def prep_ghc():
build_copy_file(PACKAGES['ghc'], 'GHC/Platform/Constants.hs')
build_copy_file(PACKAGES['ghc'], 'GHC/Settings/Config.hs')
+def prep_ghc_boot_th():
+ # Drop ghc-internal from `hs-source-dirs` as Hackage rejects this
+ modify_file(PACKAGES['ghc-boot-th'], 'ghc-boot-th.cabal',
+ lambda s: s.replace('../ghc-internal/src', ''))
+
PACKAGES = {
pkg.name: pkg
for pkg in [
@@ -105,9 +110,10 @@ PACKAGES = {
Package('template-haskell', Path("libraries/template-haskell"), no_prep),
Package('ghc-heap', Path("libraries/ghc-heap"), no_prep),
Package('ghc-boot', Path("libraries/ghc-boot"), prep_ghc_boot),
- Package('ghc-boot-th', Path("libraries/ghc-boot-th"), no_prep),
+ Package('ghc-boot-th', Path("libraries/ghc-boot-th"), prep_ghc_boot_th),
Package('ghc-compact', Path("libraries/ghc-compact"), no_prep),
Package('ghc', Path("compiler"), prep_ghc),
+ Package('ghci', Path("libraries/ghci"), no_prep),
]
}
# Dict[str, Package]
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -1114,6 +1114,7 @@ compileWholeCoreBindings ::
WholeCoreBindings ->
IO (CompiledByteCode, [FilePath])
compileWholeCoreBindings hsc_env type_env wcb = do
+ pprMarkerIO "WholeCoreBindings:" (ppr wcb_module)
core_binds <- typecheck
(stubs, foreign_files) <- decode_foreign
gen_bytecode core_binds stubs foreign_files
=====================================
compiler/GHC/Unit/Home/PackageTable.hs
=====================================
@@ -47,6 +47,7 @@ module GHC.Unit.Home.PackageTable
-- ** More Traversal-based queries
, hptCollectDependencies
, hptCollectObjects
+ , hptCollectByteCode
, hptCollectModules
-- ** Memory dangerous queries
@@ -248,6 +249,12 @@ hptCollectObjects HPT{table} = do
return $
foldr ((:) . expectJust "collectObjects" . homeModInfoObject) [] hpt
+hptCollectByteCode :: HomePackageTable -> IO [Linkable]
+hptCollectByteCode HPT{table} = do
+ hpt <- readIORef table
+ return $
+ catMaybes $ foldr ((:) . homeModInfoByteCode) [] hpt
+
-- | Collect all module ifaces in the HPT
--
-- $O(n)$ in the number of modules in the HPT.
=====================================
compiler/GHC/Utils/Trace.hs
=====================================
@@ -10,6 +10,7 @@ module GHC.Utils.Trace
, warnPprTrace
, warnPprTraceM
, pprTraceUserWarning
+ , pprMarkerIO
, trace
)
where
@@ -33,7 +34,7 @@ import GHC.Utils.GlobalVars
import GHC.Utils.Constants
import GHC.Stack
-import Debug.Trace (trace)
+import Debug.Trace (trace, traceMarkerIO)
import Control.Monad.IO.Class
-- | If debug output is on, show some 'SDoc' on the screen
@@ -101,3 +102,11 @@ traceCallStackDoc :: HasCallStack => SDoc
traceCallStackDoc =
hang (text "Call stack:")
4 (vcat $ map text $ lines (prettyCallStack callStack))
+
+-- | Emit a marker to the eventlog.
+pprMarkerIO :: String -> SDoc -> IO ()
+pprMarkerIO s msg
+ | unsafeHasNoDebugOutput = return ()
+ | otherwise = pprDebugAndThen (traceSDocContext {sdocLineLength = 10000})
+ traceMarkerIO empty (text s <+> msg)
+
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -94,6 +94,8 @@ import GHC.Unit.Finder as Finder
import GHC.Unit.Module.Graph (filterToposortToModules)
import GHC.Unit.Module.ModSummary
+import GHC.Linker.Types
+
import GHC.Data.StringBuffer
import GHC.Utils.Outputable
import GHC.Utils.Logger
@@ -176,6 +178,13 @@ import GHC.TopHandler ( topHandler )
import qualified GHC.Unit.Module.Graph as GHC
+import GHC.Conc.Sync ( forkIO, getNumCapabilities, killThread, labelThread)
+import System.Mem.Weak
+import Debug.Trace ( traceMarkerIO )
+
+import Control.Concurrent.STM.TChan
+import Control.Concurrent.STM
+
-----------------------------------------------------------------------------
data GhciSettings = GhciSettings {
@@ -589,7 +598,8 @@ interactiveUI config srcs maybe_exprs = do
mod_infos = M.empty,
flushStdHandles = flush,
noBuffering = nobuffering,
- ifaceCache = empty_cache
+ ifaceCache = empty_cache,
+ workerThread = Nothing
}
return ()
@@ -2140,6 +2150,8 @@ doLoad load_type howmuch = do
-- turn off breakpoints before we load: we can't turn them off later, because
-- the ModBreaks will have gone away.
discardActiveBreakPoints
+ -- Stop any work from the previous session being evaluated.
+ killWorkerThread
resetLastErrorLocations
-- Enable buffering stdout and stderr as we're compiling. Keeping these
@@ -2170,6 +2182,75 @@ afterLoad ok load_type = do
modulesLoadedMsg ok loaded_mods load_type
graph <- GHC.getModuleGraph
setContextAfterLoad (isReload load_type) (Just graph)
+ forceByteCode
+
+mkWorkerThread :: Int -> IO WorkerThread
+mkWorkerThread n = do
+ work_queue <- newTChanIO
+ traceMarkerIO "ghci workers created"
+ let enqueueWork work_item = atomically (writeTChan work_queue work_item)
+
+ let mkThread = do
+ tid <- forkIO $ forever $ do
+ work_item <- atomically $ readTChan work_queue
+ work_item
+ labelThread tid "ghci worker"
+ return tid
+
+ threads <- replicateM n mkThread
+
+ let shutdownWorkers = do
+ traceMarkerIO "ghci workers killed"
+ mapM_ killThread threads
+ -- NB no need to empty the chan because it is only reachable from the workers.
+
+ return $ WorkerThread{..}
+
+
+-- | Force any compiled bytecode in the background
+--
+-- During compilation the compiler leaves thunks when producing bytecode, so that
+-- the result is not forced before it is needed. (Especially important when doing recompilation
+-- checking)
+--
+-- However, after the reload is complete, the interpreter will otherwise be idle, so
+-- force those thunks in parallel so that when the user comes to write in the prompt
+-- the response is faster.
+--
+-- If a reload happens, then the thunks which have been sparked will no longer
+-- be reachable. Therefore they will be gced so we do not need to explicitly terminate
+-- the parallel work if a reload happens before we are finished.
+forceByteCode :: GhciMonad m => m ()
+forceByteCode = do
+ hsc_env <- GHC.getSession
+ -- A slightly awkward place to perform initialisation, but right now, this is the only
+ -- place where work is ever added to the queue.
+ buckets <- (2 *) <$> liftIO getNumCapabilities
+ worker <- liftIO $ mkWorkerThread buckets
+ setWorkerThread worker
+
+ let
+ queueLinkable :: Linkable -> IO ()
+ queueLinkable (Linkable _ _ ps) = mapM_ queuePart ps
+
+ queuePart (LazyBCOs x _) = do
+ w <- mkWeakPtr x Nothing
+ enqueueWork worker (mkWork w)
+ queuePart _ = return ()
+
+ -- The "work", dereferences a weak pointer and forces the value to WHNF.
+ mkWork x = do
+ wt <- deRefWeak x
+ case wt of
+ Nothing -> return ()
+ Just !_ -> return ()
+
+ -- Spawn a new thread, so the thunks are forced completely in the background of the main thread
+ -- and we can get to the prompt as fast as possible.
+ void $ liftIO $ forkIO $ do
+ all_linkables <- (concat <$> traverse (hptCollectByteCode . homeUnitEnv_hpt) (hsc_HUG hsc_env))
+ mapM_ queueLinkable all_linkables
+
setContextAfterLoad :: GhciMonad m => Bool -> Maybe GHC.ModuleGraph -> m ()
setContextAfterLoad keep_ctxt Nothing = do
=====================================
ghc/GHCi/UI/Monad.hs
=====================================
@@ -11,7 +11,7 @@
module GHCi.UI.Monad (
GHCi(..), startGHCi,
- GHCiState(..), GhciMonad(..),
+ GHCiState(..), WorkerThread(..), GhciMonad(..),
GHCiOption(..), isOptionSet, setOption, unsetOption,
Command(..), CommandResult(..), cmdSuccess,
CmdExecOutcome(..),
@@ -21,6 +21,9 @@ module GHCi.UI.Monad (
TickArray,
extractDynFlags, getDynFlags,
+ setWorkerThread,
+ killWorkerThread,
+
runStmt, runDecls, runDecls', resume, recordBreak, revertCAFs,
ActionStats(..), runAndPrintStats, runWithStats, printStats,
@@ -161,9 +164,14 @@ data GHCiState = GHCiState
-- ^ @hFlush stdout; hFlush stderr@ in the interpreter
noBuffering :: ForeignHValue,
-- ^ @hSetBuffering NoBuffering@ for stdin/stdout/stderr
- ifaceCache :: ModIfaceCache
+ ifaceCache :: ModIfaceCache,
+
+ workerThread :: Maybe WorkerThread
+ -- ^ The WorkerThread abstraction which will compute things
+ -- in the background. Currently used for evaluating bytecode.
}
+
type TickArray = Array Int [(GHC.BreakIndex,RealSrcSpan)]
-- | A GHCi command
@@ -410,6 +418,25 @@ resume canLogSpan step mbIgnoreCnt = do
reflectGHCi x $ do
GHC.resumeExec canLogSpan step mbIgnoreCnt
+{- WorkerThread implementation -}
+
+data WorkerThread =
+ WorkerThread { enqueueWork :: IO () -> IO ()
+ , shutdownWorkers :: IO ()
+ }
+
+setWorkerThread :: GhciMonad m => WorkerThread -> m ()
+setWorkerThread wt = modifyGHCiState (\st -> st { workerThread = Just wt } )
+
+killWorkerThread :: GhciMonad m => m ()
+killWorkerThread = do
+ mwt <- workerThread <$> getGHCiState
+ case mwt of
+ Nothing -> return ()
+ Just wt -> do
+ liftIO (shutdownWorkers wt)
+ modifyGHCiState (\st -> st { workerThread = Nothing })
+
-- --------------------------------------------------------------------------
-- timing & statistics
=====================================
ghc/ghc-bin.cabal.in
=====================================
@@ -40,7 +40,8 @@ Executable ghc
containers >= 0.5 && < 0.8,
transformers >= 0.5 && < 0.7,
ghc-boot == @ProjectVersionMunged@,
- ghc == @ProjectVersionMunged@
+ ghc == @ProjectVersionMunged@,
+ stm >= 2.5 && < 2.6
if os(windows)
Build-Depends: Win32 >= 2.3 && < 2.15
=====================================
libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs
=====================================
@@ -131,10 +131,10 @@ class Category a => Arrow a where
-- The default definition may be overridden with a more efficient
-- version if desired.
--
- -- > b ╭─────╮ b'
+ -- > b ╭─────╮ c
-- > >───┼─ f ─┼───>
-- > >───┼─ g ─┼───>
- -- > c ╰─────╯ c'
+ -- > b'╰─────╯ c'
(***) :: a b c -> a b' c' -> a (b,b') (c,c')
f *** g = first f >>> arr swap >>> first g >>> arr swap
where swap ~(x,y) = (y,x)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e787cccf3461f7a6708b0cdd2540d1a36fd64845...49afe39eaefad08f268852b5182ac5dc40c53491
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e787cccf3461f7a6708b0cdd2540d1a36fd64845...49afe39eaefad08f268852b5182ac5dc40c53491
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20250203/e717e821/attachment-0001.html>
More information about the ghc-commits
mailing list