[Git][ghc/ghc][wip/24107] 5 commits: driver: Ensure we actually clear the interactive context before reloading
Zubin (@wz1000)
gitlab at gitlab.haskell.org
Thu Dec 7 13:21:36 UTC 2023
Zubin pushed to branch wip/24107 at Glasgow Haskell Compiler / GHC
Commits:
64a3911f by Zubin Duggal at 2023-12-07T18:51:25+05:30
driver: Ensure we actually clear the interactive context before reloading
Previously we called discardIC, but immediately after set the session
back to an old HscEnv that still contained the IC
Partially addresses #24107
Fixes #23405
- - - - -
819f3ee8 by Zubin Duggal at 2023-12-07T18:51:25+05:30
driver: Ensure we force the lookup of old build artifacts before returning the build plan
This prevents us from retaining all previous build artifacts in memory until a
recompile finishes, instead only retaining the exact artifacts we need.
Fixes #24118
- - - - -
419a8836 by Zubin Duggal at 2023-12-07T18:51:25+05:30
testsuite: add test for #24118 and #24107
MultiLayerModulesDefsGhci was not able to catch the leak because it uses
:l which discards the previous environment.
Using :r catches both of these leaks
- - - - -
c719b909 by Zubin Duggal at 2023-12-07T18:51:25+05:30
compiler: Add some strictness annotations to ImportSpec and related constructors
This prevents us from retaining entire HscEnvs.
Force these ImportSpecs when forcing the GlobalRdrEltX
Adds an NFData instance for Bag
Fixes #24107
- - - - -
fd0db14c by Zubin Duggal at 2023-12-07T18:51:25+05:30
compiler: Force IfGlobalRdrEnv in NFData instance.
- - - - -
9 changed files:
- compiler/GHC/Data/Bag.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Types/Name/Reader.hs
- compiler/GHC/Unit/Module/ModIface.hs
- + testsuite/tests/ghci/T23405/T23405.hs
- + testsuite/tests/ghci/T23405/T23405.script
- + testsuite/tests/ghci/T23405/all.T
- + testsuite/tests/perf/compiler/MultiLayerModulesDefsGhciReload.script
- testsuite/tests/perf/compiler/all.T
Changes:
=====================================
compiler/GHC/Data/Bag.hs
=====================================
@@ -40,6 +40,7 @@ import Data.List.NonEmpty ( NonEmpty(..) )
import qualified Data.List.NonEmpty as NE
import qualified Data.Semigroup ( (<>) )
import Control.Applicative( Alternative( (<|>) ) )
+import Control.DeepSeq
infixr 3 `consBag`
infixl 3 `snocBag`
@@ -51,6 +52,12 @@ data Bag a
| ListBag (NonEmpty a)
deriving (Foldable, Functor, Traversable)
+instance NFData a => NFData (Bag a) where
+ rnf EmptyBag = ()
+ rnf (UnitBag a) = rnf a
+ rnf (TwoBags a b) = rnf a `seq` rnf b
+ rnf (ListBag a) = rnf a
+
emptyBag :: Bag a
emptyBag = EmptyBag
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -771,6 +771,7 @@ load' mhmi_cache how_much diag_wrapper mHscMessage mod_graph = do
let pruneHomeUnitEnv hme = hme { homeUnitEnv_hpt = emptyHomePackageTable }
setSession $ discardIC $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env
+ hsc_env <- getSession
-- Unload everything
liftIO $ unload interp hsc_env
@@ -780,7 +781,6 @@ load' mhmi_cache how_much diag_wrapper mHscMessage mod_graph = do
worker_limit <- liftIO $ mkWorkerLimit dflags
- setSession $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env
(upsweep_ok, new_deps) <- withDeferredDiagnostics $ do
hsc_env <- getSession
liftIO $ upsweep worker_limit hsc_env mhmi_cache diag_wrapper mHscMessage (toCache pruned_cache) build_plan
@@ -1145,33 +1145,37 @@ interpretBuildPlan hug mhmi_cache old_hpt plan = do
-- which would retain all the result variables, preventing us from collecting them
-- after they are no longer used.
!build_deps = getDependencies direct_deps build_map
- let build_action =
- withCurrentUnit (moduleGraphNodeUnitId mod) $ do
- (hug, deps) <- wait_deps_hug hug_var build_deps
+ let !build_action =
case mod of
InstantiationNode uid iu -> do
- executeInstantiationNode mod_idx n_mods hug uid iu
- return (Nothing, deps)
- ModuleNode _build_deps ms -> do
+ withCurrentUnit (moduleGraphNodeUnitId mod) $ do
+ (hug, deps) <- wait_deps_hug hug_var build_deps
+ executeInstantiationNode mod_idx n_mods hug uid iu
+ return (Nothing, deps)
+ ModuleNode _build_deps ms ->
let !old_hmi = M.lookup (msKey ms) old_hpt
rehydrate_mods = mapMaybe nodeKeyModName <$> rehydrate_nodes
- hmi <- executeCompileNode mod_idx n_mods old_hmi hug rehydrate_mods ms
- -- Write the HMI to an external cache (if one exists)
- -- See Note [Caching HomeModInfo]
- liftIO $ forM mhmi_cache $ \hmi_cache -> addHmiToCache hmi_cache hmi
- -- This global MVar is incrementally modified in order to avoid having to
- -- recreate the HPT before compiling each module which leads to a quadratic amount of work.
- liftIO $ modifyMVar_ hug_var (return . addHomeModInfoToHug hmi)
- return (Just hmi, addToModuleNameSet (moduleGraphNodeUnitId mod) (ms_mod_name ms) deps )
+ in withCurrentUnit (moduleGraphNodeUnitId mod) $ do
+ (hug, deps) <- wait_deps_hug hug_var build_deps
+ hmi <- executeCompileNode mod_idx n_mods old_hmi hug rehydrate_mods ms
+ -- Write the HMI to an external cache (if one exists)
+ -- See Note [Caching HomeModInfo]
+ liftIO $ forM mhmi_cache $ \hmi_cache -> addHmiToCache hmi_cache hmi
+ -- This global MVar is incrementally modified in order to avoid having to
+ -- recreate the HPT before compiling each module which leads to a quadratic amount of work.
+ liftIO $ modifyMVar_ hug_var (return . addHomeModInfoToHug hmi)
+ return (Just hmi, addToModuleNameSet (moduleGraphNodeUnitId mod) (ms_mod_name ms) deps )
LinkNode _nks uid -> do
- executeLinkNode hug (mod_idx, n_mods) uid direct_deps
- return (Nothing, deps)
+ withCurrentUnit (moduleGraphNodeUnitId mod) $ do
+ (hug, deps) <- wait_deps_hug hug_var build_deps
+ executeLinkNode hug (mod_idx, n_mods) uid direct_deps
+ return (Nothing, deps)
res_var <- liftIO newEmptyMVar
let result_var = mkResultVar res_var
setModulePipeline (mkNodeKey mod) (mkBuildResult origin result_var)
- return $ (MakeAction build_action res_var)
+ return $! (MakeAction build_action res_var)
buildOneLoopyModule :: ModuleGraphNodeWithBootFile -> BuildM [MakeAction]
@@ -2986,7 +2990,7 @@ runLoop fork_thread env (MakeAction act res_var :acts) = do
run_pipeline :: RunMakeM a -> IO (Maybe a)
run_pipeline p = runMaybeT (runReaderT p env)
-data MakeAction = forall a . MakeAction (RunMakeM a) (MVar (Maybe a))
+data MakeAction = forall a . MakeAction !(RunMakeM a) !(MVar (Maybe a))
waitMakeAction :: MakeAction -> IO ()
waitMakeAction (MakeAction _ mvar) = () <$ readMVar mvar
=====================================
compiler/GHC/Types/Name/Reader.hs
=====================================
@@ -574,6 +574,9 @@ data GlobalRdrEltX info
-- Note [Retrieving the GREInfo from interfaces] in GHC.Types.GREInfo.
} deriving (Data)
+instance NFData a => NFData (GlobalRdrEltX a) where
+ rnf (GRE name par _ imp info) = rnf name `seq` rnf par `seq` rnf imp `seq` rnf info
+
{- Note [IfGlobalRdrEnv]
~~~~~~~~~~~~~~~~~~~~~~~~
@@ -620,18 +623,19 @@ greParent = gre_par
greInfo :: GlobalRdrElt -> GREInfo
greInfo = gre_info
-instance NFData IfGlobalRdrElt where
- rnf !_ = ()
-
-- | See Note [Parents]
data Parent = NoParent
- | ParentIs { par_is :: Name }
+ | ParentIs { par_is :: !Name }
deriving (Eq, Data)
instance Outputable Parent where
ppr NoParent = empty
ppr (ParentIs n) = text "parent:" <> ppr n
+instance NFData Parent where
+ rnf NoParent = ()
+ rnf (ParentIs n) = rnf n
+
plusParent :: Parent -> Parent -> Parent
-- See Note [Combining parents]
plusParent p1@(ParentIs _) p2 = hasParent p1 p2
@@ -934,11 +938,10 @@ globalRdrEnvElts env = nonDetFoldOccEnv (++) [] env
-- | Drop all 'GREInfo' fields in a 'GlobalRdrEnv' in order to
-- avoid space leaks.
---
-- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
forceGlobalRdrEnv :: GlobalRdrEnvX info -> IfGlobalRdrEnv
forceGlobalRdrEnv rdrs =
- strictMapOccEnv (strictMap (\ gre -> gre { gre_info = () })) rdrs
+ strictMapOccEnv (strictMap (\ gre -> gre { gre_info = ()})) rdrs
-- | Hydrate a previously dehydrated 'GlobalRdrEnv',
-- by (lazily!) looking up the 'GREInfo' using the provided function.
@@ -1916,25 +1919,28 @@ instance Semigroup ShadowedGREs where
--
-- The 'ImportSpec' of something says how it came to be imported
-- It's quite elaborate so that we can give accurate unused-name warnings.
-data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec,
- is_item :: ImpItemSpec }
+data ImportSpec = ImpSpec { is_decl :: !ImpDeclSpec,
+ is_item :: !ImpItemSpec }
deriving( Eq, Data )
+instance NFData ImportSpec where
+ rnf = rwhnf -- All fields are strict, so we don't need to do anything
+
-- | Import Declaration Specification
--
-- Describes a particular import declaration and is
-- shared among all the 'Provenance's for that decl
data ImpDeclSpec
= ImpDeclSpec {
- is_mod :: Module, -- ^ Module imported, e.g. @import Muggle@
+ is_mod :: !Module, -- ^ Module imported, e.g. @import Muggle@
-- Note the @Muggle@ may well not be
-- the defining module for this thing!
-- TODO: either should be Module, or there
-- should be a Maybe UnitId here too.
- is_as :: ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause)
- is_qual :: Bool, -- ^ Was this import qualified?
- is_dloc :: SrcSpan -- ^ The location of the entire import declaration
+ is_as :: !ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause)
+ is_qual :: !Bool, -- ^ Was this import qualified?
+ is_dloc :: !SrcSpan -- ^ The location of the entire import declaration
} deriving (Eq, Data)
-- | Import Item Specification
@@ -1945,8 +1951,8 @@ data ImpItemSpec
-- or had a hiding list
| ImpSome {
- is_explicit :: Bool,
- is_iloc :: SrcSpan -- Location of the import item
+ is_explicit :: !Bool,
+ is_iloc :: !SrcSpan -- Location of the import item
} -- ^ The import had an import list.
-- The 'is_explicit' field is @True@ iff the thing was named
-- /explicitly/ in the import specs rather
=====================================
compiler/GHC/Unit/Module/ModIface.hs
=====================================
@@ -575,11 +575,7 @@ instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase))
`seq` rnf mi_anns
`seq` rnf mi_decls
`seq` rnf mi_extra_decls
- `seq` mi_globals
- -- NB: we already removed any potential space leaks in 'mi_globals' by
- -- dehydrating, that is, by turning the 'GlobalRdrEnv' into a 'IfGlobalRdrEnv'.
- -- This means we don't need to use 'rnf' here.
- -- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
+ `seq` rnf mi_globals
`seq` rnf mi_insts
`seq` rnf mi_fam_insts
`seq` rnf mi_rules
=====================================
testsuite/tests/ghci/T23405/T23405.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T23405 (test) where
+
+import Language.Haskell.TH
+
+test :: IO ()
+test = do
+ let s = $(getDoc (DeclDoc ''Double) >>= \doc -> [|doc|])
+ print (s `seq` ())
+
+
=====================================
testsuite/tests/ghci/T23405/T23405.script
=====================================
@@ -0,0 +1,3 @@
+:load T23405.hs
+:! echo -- an extra comment so that the hash changes >> T23405.hs
+:reload
=====================================
testsuite/tests/ghci/T23405/all.T
=====================================
@@ -0,0 +1 @@
+test('T23405', [extra_files(['T23405.hs'])], ghci_script, ['T23405.script'])
=====================================
testsuite/tests/perf/compiler/MultiLayerModulesDefsGhciReload.script
=====================================
@@ -0,0 +1,4 @@
+:set -fforce-recomp
+:l MultiLayerModules.hs
+:r
+:r
=====================================
testsuite/tests/perf/compiler/all.T
=====================================
@@ -391,6 +391,19 @@ test('MultiLayerModulesDefsGhci',
ghci_script,
['MultiLayerModulesDefsGhci.script'])
+test('MultiLayerModulesDefsGhciReload',
+ [ collect_compiler_residency(15),
+ pre_cmd('./genMultiLayerModulesDefs'),
+ extra_files(['genMultiLayerModulesDefs']),
+ compile_timeout_multiplier(5)
+ # this is _a lot_
+ # but this test has been failing every now and then,
+ # especially on i386. Let's just give it some room
+ # to complete successfully reliably everywhere.
+ ],
+ ghci_script,
+ ['MultiLayerModulesDefsGhciReload.script'])
+
test('InstanceMatching',
[ collect_compiler_stats('bytes allocated',3),
pre_cmd('$MAKE -s --no-print-directory InstanceMatching'),
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/adb8aecd2934ad0cd50dea50c6710fe4f86bc2bf...fd0db14c439d7dbacc39e0ec9e932eaea1993228
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/adb8aecd2934ad0cd50dea50c6710fe4f86bc2bf...fd0db14c439d7dbacc39e0ec9e932eaea1993228
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/20231207/0900bb12/attachment-0001.html>
More information about the ghc-commits
mailing list