From 03c46bf5e0a04225eb521bc9d48b914e47c66328 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Fri, 9 Dec 2022 19:10:01 +0530 Subject: [PATCH 1/2] Unload once per linkable instead of once per splice --- ghcide/src/Development/IDE/Core/Compile.hs | 8 +------- ghcide/src/Development/IDE/Core/Rules.hs | 8 +++++--- 2 files changed, 6 insertions(+), 10 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 68e7b29000..f75f739afd 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -160,8 +160,7 @@ computePackageDeps env pkg = do data TypecheckHelpers = TypecheckHelpers - { getLinkablesToKeep :: !(IO (ModuleEnv UTCTime)) - , getLinkables :: !([NormalizedFilePath] -> IO [LinkableResult]) + { getLinkables :: !([NormalizedFilePath] -> IO [LinkableResult]) } typecheckModule :: IdeDefer @@ -327,11 +326,6 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do ] ; let hsc_env' = loadModulesHome (map linkableHomeMod lbs) hsc_env - -- Essential to do this here after we load the linkables - ; keep_lbls <- getLinkablesToKeep - - ; unload hsc_env' $ map (\(mod, time) -> LM time mod []) $ moduleEnvToList keep_lbls - #if MIN_VERSION_ghc(9,3,0) {- load it -} ; (fv_hvs, lbss, pkgs) <- loadDecls (hscInterp hsc_env') hsc_env' srcspan bcos diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index c9d827c806..26e740c429 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -694,8 +694,7 @@ typeCheckRuleDefinition hsc pm = do unlift <- askUnliftIO let dets = TypecheckHelpers - { getLinkablesToKeep = unliftIO unlift currentLinkables - , getLinkables = unliftIO unlift . uses_ GetLinkable + { getLinkables = unliftIO unlift . uses_ GetLinkable } addUsageDependencies $ liftIO $ typecheckModule defer hsc dets pm @@ -1108,7 +1107,10 @@ getLinkableRule recorder = -- Record the linkable so we know not to unload it whenJust (hm_linkable =<< hmi) $ \(LM time mod _) -> do compiledLinkables <- getCompiledLinkables <$> getIdeGlobalAction - liftIO $ void $ modifyVar' compiledLinkables $ \old -> extendModuleEnv old mod time + liftIO $ modifyVar compiledLinkables $ \old -> do + let !to_keep = extendModuleEnv old mod time + unload (hscEnv session) (map (\(mod, time) -> LM time mod []) $ moduleEnvToList to_keep) + return (to_keep, ()) return (hash <$ hmi, (warns, LinkableResult <$> hmi <*> pure hash)) -- | For now we always use bytecode unless something uses unboxed sums and tuples along with TH From 5da533a655d0276cc1c7ade6224327326d57d9d7 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Wed, 14 Dec 2022 15:54:53 +0530 Subject: [PATCH 2/2] Docs --- ghcide/src/Development/IDE/Core/Compile.hs | 4 ++-- ghcide/src/Development/IDE/Core/Rules.hs | 12 +++++++++++- 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index f75f739afd..86bceb6deb 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -158,9 +158,9 @@ computePackageDeps env pkg = do T.pack $ "unknown package: " ++ show pkg] Just pkgInfo -> return $ Right $ unitDepends pkgInfo -data TypecheckHelpers +newtype TypecheckHelpers = TypecheckHelpers - { getLinkables :: !([NormalizedFilePath] -> IO [LinkableResult]) + { getLinkables :: ([NormalizedFilePath] -> IO [LinkableResult]) -- ^ hls-graph action to get linkables for files } typecheckModule :: IdeDefer diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 26e740c429..af19487808 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -1104,11 +1104,21 @@ getLinkableRule recorder = Just obj_t | obj_t >= core_t -> pure ([], Just $ HomeModInfo hirModIface hirModDetails (Just $ LM (posixSecondsToUTCTime obj_t) (ms_mod ms) [DotO obj_file])) _ -> liftIO $ coreFileToLinkable linkableType (hscEnv session) ms hirModIface hirModDetails bin_core (error "object doesn't have time") - -- Record the linkable so we know not to unload it + -- Record the linkable so we know not to unload it, and unload old versions whenJust (hm_linkable =<< hmi) $ \(LM time mod _) -> do compiledLinkables <- getCompiledLinkables <$> getIdeGlobalAction liftIO $ modifyVar compiledLinkables $ \old -> do let !to_keep = extendModuleEnv old mod time + --We need to unload old linkables before we can load in new linkables. However, + --the unload function in the GHC API takes a list of linkables to keep (i.e. + --not unload). Earlier we unloaded right before loading in new linkables, which + --is effectively once per splice. This can be slow as unload needs to walk over + --the list of all loaded linkables, for each splice. + -- + --Solution: now we unload old linkables right after we generate a new linkable and + --just before returning it to be loaded. This has a substantial effect on recompile + --times as the number of loaded modules and splices increases. + -- unload (hscEnv session) (map (\(mod, time) -> LM time mod []) $ moduleEnvToList to_keep) return (to_keep, ()) return (hash <$ hmi, (warns, LinkableResult <$> hmi <*> pure hash))