[Git][ghc/ghc][wip/24107] 3 commits: compiler: Add some strictness annotations to ImportSpec and related constructors
Zubin (@wz1000)
gitlab at gitlab.haskell.org
Fri Dec 1 11:20:39 UTC 2023
Zubin pushed to branch wip/24107 at Glasgow Haskell Compiler / GHC
Commits:
8b9acb6b by Zubin Duggal at 2023-12-01T16:46:01+05:30
compiler: Add some strictness annotations to ImportSpec and related constructors
This prevents us from retain entire HscEnvs.
Fixes #24107
- - - - -
bd274de5 by Zubin Duggal at 2023-12-01T16:46:01+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
- - - - -
3a131559 by Zubin Duggal at 2023-12-01T16:50:30+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
- - - - -
4 changed files:
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Types/Name/Reader.hs
- testsuite/tests/perf/compiler/all.T
Changes:
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -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/Rename/Names.hs
=====================================
@@ -1202,7 +1202,7 @@ filterImports hsc_env iface decl_spec Nothing
= return (Nothing, gresFromAvails hsc_env (Just imp_spec) all_avails)
where
all_avails = mi_exports iface
- imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
+ !imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
= do -- check for errors, convert RdrNames to Names
@@ -1582,7 +1582,7 @@ gresFromIE decl_spec (L loc ie, gres)
item_spec = ImpSome { is_explicit = is_explicit name
, is_iloc = locA loc }
set_gre_imp gre@( GRE { gre_name = nm } )
- = gre { gre_imp = unitBag $ prov_fn nm }
+ = gre { gre_imp = unitBag $! prov_fn nm }
{-
Note [Children for duplicate record fields]
=====================================
compiler/GHC/Types/Name/Reader.hs
=====================================
@@ -1916,8 +1916,8 @@ 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 )
-- | Import Declaration Specification
@@ -1926,15 +1926,15 @@ data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec,
-- 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 +1945,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
=====================================
testsuite/tests/perf/compiler/all.T
=====================================
@@ -392,6 +392,19 @@ test('MultiLayerModulesDefsGhci',
ghci_script,
['MultiLayerModulesDefsGhci.script'])
+test('MultiLayerModulesDefsGhciReload',
+ [ collect_compiler_residency(15),
+ pre_cmd('./genMultiLayerModulesDefsReload'),
+ extra_files(['genMultiLayerModulesDefsReload']),
+ 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/cb55e42f7808a87d83828523b0d5c7c97e3cd00b...3a131559536dd9e7d704b10d3f0baf2fdc7bee61
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cb55e42f7808a87d83828523b0d5c7c97e3cd00b...3a131559536dd9e7d704b10d3f0baf2fdc7bee61
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/20231201/cc5c9fc5/attachment-0001.html>
More information about the ghc-commits
mailing list