From 77d1d3fe03faa2fa3283c79a71f90aca99085e04 Mon Sep 17 00:00:00 2001 From: Fendor Date: Fri, 9 Jul 2021 13:20:52 +0200 Subject: [PATCH] Add POC for HLS loading multiple components on startup Powered by hie-bios. --- cabal.project | 5 + ghcide/ghcide.cabal | 2 +- .../session-loader/Development/IDE/Session.hs | 152 ++++++++++-------- 3 files changed, 93 insertions(+), 66 deletions(-) diff --git a/cabal.project b/cabal.project index 446a3ee956..201ba86989 100644 --- a/cabal.project +++ b/cabal.project @@ -37,6 +37,11 @@ source-repository-package location: https://github.com/hsyl20/ghc-api-compat tag: 8fee87eac97a538dbe81ff1ab18cff10f2f9fa15 +source-repository-package + type: git + location: https://github.com/fendor/hie-bios + tag: fe823adfa0e82aa76e098a57cc424c92902e1db8 + write-ghc-environment-files: never index-state: 2021-08-12T12:00:38Z diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index debdfc8f0a..24758955f9 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -100,7 +100,7 @@ library ghc-paths, ghc-api-compat, cryptohash-sha1 >=0.11.100 && <0.12, - hie-bios >= 0.7.1 && < 0.8.0, + hie-bios >= 0.8.0 && < 0.9.0, implicit-hie-cradle >= 0.3.0.5 && < 0.4, base16-bytestring >=0.1.1 && <1.1 if os(windows) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index b769ed916a..3d5a2d9759 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -85,6 +85,9 @@ import Database.SQLite.Simple import HieDb.Create import HieDb.Types import HieDb.Utils +import Ide.Types (dynFlagsModifyGlobal) +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as NE -- | Bump this version number when making changes to the format of the data stored in hiedb hiedbDataVersion :: String @@ -230,7 +233,9 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do filesMap <- newVar HM.empty :: IO (Var FilesMap) -- Version of the mappings above version <- newVar 0 - let returnWithVersion fun = IdeGhcSession fun <$> liftIO (readVar version) + let returnWithVersion :: (FilePath -> IO (IdeResult HscEnvEq, [FilePath])) + -> Action IdeGhcSession + returnWithVersion fun = (IdeGhcSession fun) <$> liftIO (readVar version) -- This caches the mapping from Mod.hs -> hie.yaml cradleLoc <- liftIO $ memoIO $ \v -> do res <- findCradle v @@ -277,9 +282,9 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do -- If the hieYaml file already has an HscEnv, the new component is -- combined with the components in the old HscEnv into a new HscEnv -- which contains the union. - let packageSetup :: (Maybe FilePath, NormalizedFilePath, ComponentOptions, FilePath) - -> IO (HscEnv, ComponentInfo, [ComponentInfo]) - packageSetup (hieYaml, cfp, opts, libDir) = do + let packageSetup :: (Maybe FilePath, NormalizedFilePath, NonEmpty ComponentOptions, FilePath) + -> IO [(HscEnv, ComponentInfo, [ComponentInfo])] + packageSetup (hieYaml, cfp, allOpts, libDir) = concatForM (NE.toList allOpts) $ \opts -> do -- Parse DynFlags for the newly discovered component hscEnv <- emptyHscEnv ideNc libDir (df, targets) <- evalGhcEnv hscEnv $ setOptions opts (hsc_dflags hscEnv) @@ -289,7 +294,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do -- or making a new one. The lookup returns the HscEnv and a list of -- information about other components loaded into the HscEnv -- (unitId, DynFlag, Targets) - modifyVar hscEnvs $ \m -> do + r <- modifyVar hscEnvs $ \m -> do -- Just deps if there's already an HscEnv -- Nothing is it's the first time we are making an HscEnv let oldDeps = Map.lookup hieYaml m @@ -343,12 +348,13 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do -- . The modified information (without -inplace flags) for -- existing packages pure (Map.insert hieYaml (newHscEnv, new_deps) m, (newHscEnv, head new_deps', tail new_deps')) + pure [r] - let session :: (Maybe FilePath, NormalizedFilePath, ComponentOptions, FilePath) + let session :: (Maybe FilePath, NormalizedFilePath, NonEmpty ComponentOptions, FilePath) -> IO (IdeResult HscEnvEq,[FilePath]) - session args@(hieYaml, _cfp, _opts, _libDir) = do - (hscEnv, new, old_deps) <- packageSetup args + session args@(hieYaml, cfp, _opts, _libDir) = do + setupInfos <- packageSetup args -- (hscEnvs, new, old_deps) -- Whenever we spin up a session on Linux, dynamically load libm.so.6 -- in. We need this in case the binary is statically linked, in which @@ -358,58 +364,73 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do -- some code. If the binary is dynamically linked, then this will have -- no effect. -- See https://github.com/haskell/haskell-language-server/issues/221 - when (os == "linux") $ do - initObjLinker hscEnv - res <- loadDLL hscEnv "libm.so.6" - case res of - Nothing -> pure () - Just err -> hPutStrLn stderr $ - "Error dynamically loading libm.so.6:\n" <> err - - -- Make a map from unit-id to DynFlags, this is used when trying to - -- resolve imports. (especially PackageImports) - let uids = map (\ci -> (componentUnitId ci, componentDynFlags ci)) (new : old_deps) - - -- For each component, now make a new HscEnvEq which contains the - -- HscEnv for the hie.yaml file but the DynFlags for that component - - -- New HscEnv for the component in question, returns the new HscEnvEq and - -- a mapping from FilePath to the newly created HscEnvEq. - let new_cache = newComponentCache logger optExtensions hieYaml _cfp hscEnv uids - (cs, res) <- new_cache new - -- Modified cache targets for everything else in the hie.yaml file - -- which now uses the same EPS and so on - cached_targets <- concatMapM (fmap fst . new_cache) old_deps - - let all_targets = cs ++ cached_targets - - void $ modifyVar' fileToFlags $ - Map.insert hieYaml (HM.fromList (concatMap toFlagsMap all_targets)) - void $ modifyVar' filesMap $ - flip HM.union (HM.fromList (zip (map fst $ concatMap toFlagsMap all_targets) (repeat hieYaml))) - - void $ extendKnownTargets all_targets - - -- Invalidate all the existing GhcSession build nodes by restarting the Shake session - invalidateShakeCache - restartShakeSession [] - - -- Typecheck all files in the project on startup - checkProject <- getCheckProject - unless (null cs || not checkProject) $ do - cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) (concatMap targetLocations cs) - void $ shakeEnqueue extras $ mkDelayedAction "InitialLoad" Debug $ void $ do - mmt <- uses GetModificationTime cfps' - let cs_exist = catMaybes (zipWith (<$) cfps' mmt) - modIfaces <- uses GetModIface cs_exist - -- update exports map - extras <- getShakeExtras - let !exportsMap' = createExportsMap $ mapMaybe (fmap hirModIface) modIfaces - liftIO $ modifyVar_ (exportsMap extras) $ evaluate . (exportsMap' <>) - - return (second Map.keys res) - - let consultCradle :: Maybe FilePath -> FilePath -> IO (IdeResult HscEnvEq, [FilePath]) + forM_ setupInfos $ \(hscEnv, new, old_deps) -> do + when (os == "linux") $ do + initObjLinker hscEnv + res <- loadDLL hscEnv "libm.so.6" + case res of + Nothing -> pure () + Just err -> hPutStrLn stderr $ + "Error dynamically loading libm.so.6:\n" <> err + + -- Make a map from unit-id to DynFlags, this is used when trying to + -- resolve imports. (especially PackageImports) + let uids = map (\ci -> (componentUnitId ci, componentDynFlags ci)) (new : old_deps) + + -- For each component, now make a new HscEnvEq which contains the + -- HscEnv for the hie.yaml file but the DynFlags for that component + + -- New HscEnv for the component in question, returns the new HscEnvEq and + -- a mapping from FilePath to the newly created HscEnvEq. + let new_cache = newComponentCache logger optExtensions hieYaml cfp hscEnv uids + (cs, _res) <- new_cache new + -- Modified cache targets for everything else in the hie.yaml file + -- which now uses the same EPS and so on + cached_targets <- concatMapM (fmap fst . new_cache) old_deps + + let all_targets = cs ++ cached_targets + + void $ modifyVar' fileToFlags $ + Map.insert hieYaml (HM.fromList (concatMap toFlagsMap all_targets)) + void $ modifyVar' filesMap $ + flip HM.union (HM.fromList (zip (map fst $ concatMap toFlagsMap all_targets) (repeat hieYaml))) + + void $ extendKnownTargets all_targets + + -- Invalidate all the existing GhcSession build nodes by restarting the Shake session + invalidateShakeCache + restartShakeSession [] + + -- Typecheck all files in the project on startup + checkProject <- getCheckProject + unless (null cs || not checkProject) $ do + cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) (concatMap targetLocations cs) + void $ shakeEnqueue extras $ mkDelayedAction "InitialLoad" Debug $ void $ do + mmt <- uses GetModificationTime cfps' + let cs_exist = catMaybes (zipWith (<$) cfps' mmt) + modIfaces <- uses GetModIface cs_exist + -- update exports map + extras <- getShakeExtras + let !exportsMap' = createExportsMap $ mapMaybe (fmap hirModIface) modIfaces + liftIO $ modifyVar_ (exportsMap extras) $ evaluate . (exportsMap' <>) + + yamlMap <- readVar fileToFlags + let (hscEnvEq, depInfo) = (yamlMap Map.! hieYaml) HM.! cfp + pure (hscEnvEq, Map.keys depInfo) + + -- Let's be insanely hacky! + -- Go through all new components and find the one that the given fp most likely + -- belongs to. + -- Since all ComponentInfo's carry a proof for which file caused their creation, + -- and add this file to their targets, we need to do some post-processing. + -- It is an implementation detail that the first known target is the normalized + -- filepath of the proof file. + -- Let's strip it away and let's see whether the targets still contain 'cfp'! + -- If they do, it must be the home component of cfp. + -- If we find it, remove it as a target from all other 'HscEnvEq' to avoid recompilation + -- issues. + + let consultCradle :: Maybe FilePath -> FilePath -> IO (IdeResult HscEnvEq,[FilePath]) consultCradle hieYaml cfp = do lfp <- flip makeRelative cfp <$> getCurrentDirectory logInfo logger $ T.pack ("Consulting the cradle for " <> show lfp) @@ -441,7 +462,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do InstallationMismatch{..} -> return (([renderPackageSetupException cfp GhcVersionMismatch{..}], Nothing),[]) InstallationChecked _compileTime _ghcLibCheck -> - session (hieYaml, toNormalizedFilePath' cfp, opts, libDir) + session (hieYaml, toNormalizedFilePath' cfp, opts, libDir) -- Failure case, either a cradle error or the none cradle Left err -> do dep_info <- getDependencyInfo (maybeToList hieYaml) @@ -498,7 +519,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do -- GHC options/dynflags needed for the session and the GHC library directory cradleToOptsAndLibDir :: Show a => Cradle a -> FilePath - -> IO (Either [CradleError] (ComponentOptions, FilePath)) + -> IO (Either [CradleError] (NonEmpty ComponentOptions, FilePath)) cradleToOptsAndLibDir cradle file = do -- Start off by getting the session options hPutStrLn stderr $ "Output from setting up the cradle " <> show cradle @@ -574,7 +595,7 @@ newComponentCache -> [(InstalledUnitId, DynFlags)] -> ComponentInfo -> IO ( [TargetDetails], (IdeResult HscEnvEq, DependencyInfo)) -newComponentCache logger exts cradlePath cfp hsc_env uids ci = do +newComponentCache logger exts cradlePath _cfp hsc_env uids ci = do let df = componentDynFlags ci let hscEnv' = hsc_env { hsc_dflags = df , hsc_IC = (hsc_IC hsc_env) { ic_dflags = df } } @@ -594,8 +615,9 @@ newComponentCache logger exts cradlePath cfp hsc_env uids ci = do -- the component, in which case things will be horribly broken anyway. -- Otherwise, we will immediately attempt to reload this module which -- causes an infinite loop and high CPU usage. - let special_target = TargetDetails (TargetFile cfp) targetEnv targetDepends [componentFP ci] - return (special_target:ctargets, res) + -- let special_target = TargetDetails (TargetFile cfp) targetEnv targetDepends [componentFP ci] + -- return (special_target:ctargets, res) + return (ctargets, res) {- Note [Avoiding bad interface files] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~