Skip to content

Commit 7665e2c

Browse files
wz1000wz1000
committed
Remove pre-multi component junk for GHC <= 9.2
1 parent 68298b3 commit 7665e2c

File tree

7 files changed

+21
-94
lines changed

7 files changed

+21
-94
lines changed

‎ghcide/session-loader/Development/IDE/Session.hs

Lines changed: 6 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -62,8 +62,7 @@ import Development.IDE.Graph (Action)
6262
import qualified Development.IDE.Session.Implicit as GhcIde
6363
import Development.IDE.Types.Diagnostics
6464
import Development.IDE.Types.Exports
65-
import Development.IDE.Types.HscEnvEq (HscEnvEq, newHscEnvEq,
66-
newHscEnvEqPreserveImportPaths)
65+
import Development.IDE.Types.HscEnvEq (HscEnvEq, newHscEnvEq)
6766
import Development.IDE.Types.Location
6867
import Development.IDE.Types.Options
6968
import GHC.ResponseFile
@@ -569,8 +568,8 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
569568
-- For GHC's supporting multi component sessions, we create a shared
570569
-- HscEnv but set the active component accordingly
571570
hscEnv <- emptyHscEnv ideNc _libDir
572-
let new_cache = newComponentCache recorder optExtensions hieYaml _cfp hscEnv
573-
all_target_details <- new_cache old_deps new_deps rootDir
571+
let new_cache = newComponentCache recorder optExtensions _cfp hscEnv
572+
all_target_details <- new_cache old_deps new_deps
574573

575574
this_dep_info <- getDependencyInfo $ maybeToList hieYaml
576575
let (all_targets, this_flags_map, this_options)
@@ -761,10 +760,6 @@ emptyHscEnv nc libDir = do
761760
-- We need to do this before we call initUnits.
762761
env <- runGhc (Just libDir) $
763762
getSessionDynFlags >>= setSessionDynFlags >> getSession
764-
-- On GHC 9.2 calling setSessionDynFlags caches the unit databases
765-
-- for an empty environment. This prevents us from reading the
766-
-- package database subsequently. So clear the unit db cache in
767-
-- hsc_unit_dbs
768763
pure $ setNameCache nc (hscSetFlags ((hsc_dflags env){useUnicode = True }) env)
769764

770765
data TargetDetails = TargetDetails
@@ -870,14 +865,12 @@ checkHomeUnitsClosed' ue home_id_set
870865
newComponentCache
871866
:: Recorder (WithPriority Log)
872867
-> [String] -- ^ File extensions to consider
873-
-> Maybe FilePath -- ^ Path to cradle
874868
-> NormalizedFilePath -- ^ Path to file that caused the creation of this component
875869
-> HscEnv -- ^ An empty HscEnv
876870
-> [ComponentInfo] -- ^ New components to be loaded
877871
-> [ComponentInfo] -- ^ old, already existing components
878-
-> FilePath -- ^ root dir, see Note [Root Directory]
879872
-> IO [ [TargetDetails] ]
880-
newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis dir = do
873+
newComponentCache recorder exts _cfp hsc_env old_cis new_cis = do
881874
let cis = Map.unionWith unionCIs (mkMap new_cis) (mkMap old_cis)
882875
-- When we have multiple components with the same uid,
883876
-- prefer the new one over the old.
@@ -917,13 +910,12 @@ newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis dir = do
917910

918911
forM (Map.elems cis) $ \ci -> do
919912
let df = componentDynFlags ci
920-
let createHscEnvEq = maybe newHscEnvEqPreserveImportPaths (newHscEnvEq dir) cradlePath
921913
thisEnv <- do
922914
-- In GHC 9.4 we have multi component support, and we have initialised all the units
923915
-- above.
924916
-- We just need to set the current unit here
925917
pure $ hscSetActiveUnitId (homeUnitId_ df) hscEnv'
926-
henv <- createHscEnvEq thisEnv (zip uids dfs)
918+
henv <- newHscEnvEq thisEnv
927919
let targetEnv = (if isBad ci then multi_errs else [], Just henv)
928920
targetDepends = componentDependencyInfo ci
929921
logWith recorder Debug $ LogNewComponentCache (targetEnv, targetDepends)
@@ -1185,14 +1177,7 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags rootDir = do
11851177
Compat.setUpTypedHoles $
11861178
makeDynFlagsAbsolute compRoot -- makeDynFlagsAbsolute already accounts for workingDirectory
11871179
dflags''
1188-
-- initPackages parses the -package flags and
1189-
-- sets up the visibility for each component.
1190-
-- Throws if a -package flag cannot be satisfied.
1191-
-- This only works for GHC <9.2
1192-
-- For GHC >= 9.2, we need to modify the unit env in the hsc_dflags, which
1193-
-- is done later in newComponentCache
1194-
final_flags <- liftIO $ wrapPackageSetupException $ Compat.oldInitUnits dflags'''
1195-
return (final_flags, targets)
1180+
return (dflags''', targets)
11961181

11971182
setIgnoreInterfacePragmas :: DynFlags -> DynFlags
11981183
setIgnoreInterfacePragmas df =

‎ghcide/src/Development/IDE.hs

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -50,7 +50,6 @@ import Development.IDE.Graph as X (Action, RuleResult,
5050
import Development.IDE.Plugin as X
5151
import Development.IDE.Types.Diagnostics as X
5252
import Development.IDE.Types.HscEnvEq as X (HscEnvEq (..),
53-
hscEnv,
54-
hscEnvWithImportPaths)
53+
hscEnv)
5554
import Development.IDE.Types.Location as X
5655
import Ide.Logger as X

‎ghcide/src/Development/IDE/Core/Rules.hs

Lines changed: 6 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -319,18 +319,11 @@ getLocatedImportsRule recorder =
319319
(KnownTargets targets targetsMap) <- useNoFile_ GetKnownTargets
320320
let imports = [(False, imp) | imp <- ms_textual_imps ms] ++ [(True, imp) | imp <- ms_srcimps ms]
321321
env_eq <- use_ GhcSession file
322-
let env = hscEnvWithImportPaths env_eq
323-
let import_dirs = deps env_eq
322+
let env = hscEnv env_eq
323+
let import_dirs = map (second homeUnitEnv_dflags) $ hugElts $ hsc_HUG env
324324
let dflags = hsc_dflags env
325-
isImplicitCradle = isNothing $ envImportPaths env_eq
326-
let dflags' = if isImplicitCradle
327-
then addRelativeImport file (moduleName $ ms_mod ms) dflags
328-
else dflags
329325
opt <- getIdeOptions
330326
let getTargetFor modName nfp
331-
| isImplicitCradle = do
332-
itExists <- getFileExists nfp
333-
return $ if itExists then Just nfp else Nothing
334327
| Just (TargetFile nfp') <- HM.lookup (TargetFile nfp) targetsMap = do
335328
-- reuse the existing NormalizedFilePath in order to maximize sharing
336329
itExists <- getFileExists nfp'
@@ -341,10 +334,11 @@ getLocatedImportsRule recorder =
341334
nfp' = HM.lookupDefault nfp nfp ttmap
342335
itExists <- getFileExists nfp'
343336
return $ if itExists then Just nfp' else Nothing
344-
| otherwise
345-
= return Nothing
337+
| otherwise = do
338+
itExists <- getFileExists nfp
339+
return $ if itExists then Just nfp else Nothing
346340
(diags, imports') <- fmap unzip $ forM imports $ \(isSource, (mbPkgName, modName)) -> do
347-
diagOrImp <- locateModule (hscSetFlags dflags' env) import_dirs (optExtensions opt) getTargetFor modName mbPkgName isSource
341+
diagOrImp <- locateModule (hscSetFlags dflags env) import_dirs (optExtensions opt) getTargetFor modName mbPkgName isSource
348342
case diagOrImp of
349343
Left diags -> pure (diags, Just (modName, Nothing))
350344
Right (FileImport path) -> pure ([], Just (modName, Just path))

‎ghcide/src/Development/IDE/GHC/Compat/Units.hs

Lines changed: 0 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,6 @@ module Development.IDE.GHC.Compat.Units (
55
-- * UnitState
66
UnitState,
77
initUnits,
8-
oldInitUnits,
98
unitState,
109
getUnitName,
1110
explicitUnits,
@@ -127,12 +126,6 @@ initUnits unitDflags env = do
127126
pure $ hscSetFlags dflags1 $ hscSetUnitEnv unit_env env
128127

129128

130-
-- | oldInitUnits only needs to modify DynFlags for GHC <9.2
131-
-- For GHC >= 9.2, we need to set the hsc_unit_env also, that is
132-
-- done later by initUnits
133-
oldInitUnits :: DynFlags -> IO DynFlags
134-
oldInitUnits = pure
135-
136129
explicitUnits :: UnitState -> [Unit]
137130
explicitUnits ue =
138131
map fst $ State.explicitUnits ue

‎ghcide/src/Development/IDE/Types/HscEnvEq.hs

Lines changed: 5 additions & 49 deletions
Original file line numberDiff line numberDiff line change
@@ -1,25 +1,18 @@
11
module Development.IDE.Types.HscEnvEq
22
( HscEnvEq,
33
hscEnv, newHscEnvEq,
4-
hscEnvWithImportPaths,
5-
newHscEnvEqPreserveImportPaths,
6-
newHscEnvEqWithImportPaths,
74
updateHscEnvEq,
8-
envImportPaths,
95
envPackageExports,
106
envVisibleModuleNames,
11-
deps
127
) where
138

149

1510
import Control.Concurrent.Async (Async, async, waitCatch)
1611
import Control.Concurrent.Strict (modifyVar, newVar)
17-
import Control.DeepSeq (force)
12+
import Control.DeepSeq (force, rwhnf)
1813
import Control.Exception (evaluate, mask, throwIO)
1914
import Control.Monad.Extra (eitherM, join, mapMaybeM)
2015
import Data.Either (fromRight)
21-
import Data.Set (Set)
22-
import qualified Data.Set as Set
2316
import Data.Unique (Unique)
2417
import qualified Data.Unique as Unique
2518
import Development.IDE.GHC.Compat hiding (newUnique)
@@ -28,23 +21,14 @@ import Development.IDE.GHC.Error (catchSrcErrors)
2821
import Development.IDE.GHC.Util (lookupPackageConfig)
2922
import Development.IDE.Graph.Classes
3023
import Development.IDE.Types.Exports (ExportsMap, createExportsMap)
31-
import Ide.PluginUtils (toAbsolute)
3224
import OpenTelemetry.Eventlog (withSpan)
33-
import System.FilePath
3425

3526
-- | An 'HscEnv' with equality. Two values are considered equal
3627
-- if they are created with the same call to 'newHscEnvEq' or
3728
-- 'updateHscEnvEq'.
3829
data HscEnvEq = HscEnvEq
3930
{ envUnique :: !Unique
4031
, hscEnv :: !HscEnv
41-
, deps :: [(UnitId, DynFlags)]
42-
-- ^ In memory components for this HscEnv
43-
-- This is only used at the moment for the import dirs in
44-
-- the DynFlags
45-
, envImportPaths :: Maybe (Set FilePath)
46-
-- ^ If Just, import dirs originally configured in this env
47-
-- If Nothing, the env import dirs are unaltered
4832
, envPackageExports :: IO ExportsMap
4933
, envVisibleModuleNames :: IO (Maybe [ModuleName])
5034
-- ^ 'listVisibleModuleNames' is a pure function,
@@ -59,19 +43,8 @@ updateHscEnvEq oldHscEnvEq newHscEnv = do
5943
update <$> Unique.newUnique
6044

6145
-- | Wrap an 'HscEnv' into an 'HscEnvEq'.
62-
newHscEnvEq :: FilePath -> FilePath -> HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq
63-
newHscEnvEq root cradlePath hscEnv0 deps = do
64-
let relativeToCradle = (takeDirectory cradlePath </>)
65-
hscEnv = removeImportPaths hscEnv0
66-
67-
-- Make Absolute since targets are also absolute
68-
let importPathsCanon = toAbsolute root . relativeToCradle <$> importPaths (hsc_dflags hscEnv0)
69-
70-
newHscEnvEqWithImportPaths (Just $ Set.fromList importPathsCanon) hscEnv deps
71-
72-
newHscEnvEqWithImportPaths :: Maybe (Set FilePath) -> HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq
73-
newHscEnvEqWithImportPaths envImportPaths hscEnv deps = do
74-
46+
newHscEnvEq :: HscEnv -> IO HscEnvEq
47+
newHscEnvEq hscEnv = do
7548
let dflags = hsc_dflags hscEnv
7649

7750
envUnique <- Unique.newUnique
@@ -112,33 +85,16 @@ newHscEnvEqWithImportPaths envImportPaths hscEnv deps = do
11285

11386
return HscEnvEq{..}
11487

115-
-- | Wrap an 'HscEnv' into an 'HscEnvEq'.
116-
newHscEnvEqPreserveImportPaths
117-
:: HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq
118-
newHscEnvEqPreserveImportPaths = newHscEnvEqWithImportPaths Nothing
119-
120-
-- | Unwrap the 'HscEnv' with the original import paths.
121-
-- Used only for locating imports
122-
hscEnvWithImportPaths :: HscEnvEq -> HscEnv
123-
hscEnvWithImportPaths HscEnvEq{..}
124-
| Just imps <- envImportPaths
125-
= hscSetFlags (setImportPaths (Set.toList imps) (hsc_dflags hscEnv)) hscEnv
126-
| otherwise
127-
= hscEnv
128-
129-
removeImportPaths :: HscEnv -> HscEnv
130-
removeImportPaths hsc = hscSetFlags (setImportPaths [] (hsc_dflags hsc)) hsc
131-
13288
instance Show HscEnvEq where
13389
show HscEnvEq{envUnique} = "HscEnvEq " ++ show (Unique.hashUnique envUnique)
13490

13591
instance Eq HscEnvEq where
13692
a == b = envUnique a == envUnique b
13793

13894
instance NFData HscEnvEq where
139-
rnf (HscEnvEq a b c d _ _) =
95+
rnf (HscEnvEq a b _ _) =
14096
-- deliberately skip the package exports map and visible module names
141-
rnf (Unique.hashUnique a) `seq` b `seq` c `seq` rnf d
97+
rnf (Unique.hashUnique a) `seq` rwhnf b
14298

14399
instance Hashable HscEnvEq where
144100
hashWithSalt s = hashWithSalt s . envUnique

‎plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -38,7 +38,7 @@ import Development.IDE (GetParsedModule (GetParse
3838
Priority (Debug),
3939
Recorder, WithPriority,
4040
colon, evalGhcEnv,
41-
hscEnvWithImportPaths,
41+
hscEnv,
4242
logWith,
4343
realSrcSpanToRange,
4444
rootDir, runAction,
@@ -140,7 +140,7 @@ pathModuleNames recorder state normFilePath filePath
140140
| firstLetter isLower $ takeFileName filePath = return ["Main"]
141141
| otherwise = do
142142
(session, _) <- runActionE "ModuleName.ghcSession" state $ useWithStaleE GhcSession normFilePath
143-
srcPaths <- liftIO $ evalGhcEnv (hscEnvWithImportPaths session) $ importPaths <$> getSessionDynFlags
143+
srcPaths <- liftIO $ evalGhcEnv (hscEnv session) $ importPaths <$> getSessionDynFlags
144144
logWith recorder Debug (SrcPaths srcPaths)
145145

146146
-- Append a `pathSeparator` to make the path looks like a directory,

‎plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -210,7 +210,7 @@ setupHscEnv ideState fp pm = do
210210
hscEnvEq <- runActionE "expandTHSplice.fallback.ghcSessionDeps" ideState $
211211
useE GhcSessionDeps fp
212212
let ps = annotateParsedSource pm
213-
hscEnv0 = hscEnvWithImportPaths hscEnvEq
213+
hscEnv0 = hscEnv hscEnvEq
214214
modSum = pm_mod_summary pm
215215
hscEnv <- liftIO $ setupDynFlagsForGHCiLike hscEnv0 $ ms_hspp_opts modSum
216216
pure (ps, hscEnv, hsc_dflags hscEnv)

0 commit comments

Comments
 (0)