11{-# LANGUAGE ExistentialQuantification #-}
22{-# LANGUAGE RankNTypes #-}
33{-# LANGUAGE TypeFamilies #-}
4+ {-# LANGUAGE CPP #-}
45
56{-|
67The logic for setting up a ghcide session by tapping into hie-bios.
@@ -100,6 +101,9 @@ import HieDb.Types
100101import HieDb.Utils
101102import qualified System.Random as Random
102103import System.Random (RandomGen )
104+ import Control.Monad.IO.Unlift (MonadUnliftIO )
105+ import Control.Exception (evaluate )
106+ import Control.DeepSeq
103107
104108data Log
105109 = LogSettingInitialDynFlags
@@ -208,11 +212,13 @@ data SessionLoadingOptions = SessionLoadingOptions
208212 , getCacheDirs :: String -> [String ] -> IO CacheDirs
209213 -- | Return the GHC lib dir to use for the 'unsafeGlobalDynFlags'
210214 , getInitialGhcLibDir :: Recorder (WithPriority Log ) -> FilePath -> IO (Maybe LibDir )
215+ # if ! MIN_VERSION_ghc (9 ,3 ,0 )
211216 , fakeUid :: UnitId
212217 -- ^ unit id used to tag the internal component built by ghcide
213218 -- To reuse external interface files the unit ids must match,
214219 -- thus make sure to build them with `--this-unit-id` set to the
215220 -- same value as the ghcide fake uid
221+ # endif
216222 }
217223
218224instance Default SessionLoadingOptions where
@@ -221,7 +227,9 @@ instance Default SessionLoadingOptions where
221227 ,loadCradle = loadWithImplicitCradle
222228 ,getCacheDirs = getCacheDirsDefault
223229 ,getInitialGhcLibDir = getInitialGhcLibDirDefault
230+ #if !MIN_VERSION_ghc(9,3,0)
224231 ,fakeUid = Compat. toUnitId (Compat. stringToUnit " main" )
232+ #endif
225233 }
226234
227235-- | Find the cradle for a given 'hie.yaml' configuration.
@@ -494,7 +502,11 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
494502 new_deps' <- forM new_deps $ \ RawComponentInfo {.. } -> do
495503 -- Remove all inplace dependencies from package flags for
496504 -- components in this HscEnv
505+ #if MIN_VERSION_ghc(9,3,0)
506+ let (df2, uids) = (rawComponentDynFlags, [] )
507+ #else
497508 let (df2, uids) = removeInplacePackages fakeUid inplace rawComponentDynFlags
509+ #endif
498510 let prefix = show rawComponentUnitId
499511 -- See Note [Avoiding bad interface files]
500512 let hscComponents = sort $ map show uids
@@ -517,10 +529,14 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
517529 -- that I do not fully understand
518530 log Info $ LogMakingNewHscEnv inplace
519531 hscEnv <- emptyHscEnv ideNc libDir
520- newHscEnv <-
532+ ! newHscEnv <-
521533 -- Add the options for the current component to the HscEnv
522534 evalGhcEnv hscEnv $ do
523- _ <- setSessionDynFlags $ setHomeUnitId_ fakeUid df
535+ _ <- setSessionDynFlags
536+ #if !MIN_VERSION_ghc(9,3,0)
537+ $ setHomeUnitId_ fakeUid
538+ #endif
539+ df
524540 getSession
525541
526542 -- Modify the map so the hieYaml now maps to the newly created
@@ -718,7 +734,11 @@ cradleToOptsAndLibDir recorder cradle file = do
718734 logWith recorder Info $ LogNoneCradleFound file
719735 return (Left [] )
720736
737+ #if MIN_VERSION_ghc(9,3,0)
738+ emptyHscEnv :: NameCache -> FilePath -> IO HscEnv
739+ #else
721740emptyHscEnv :: IORef NameCache -> FilePath -> IO HscEnv
741+ #endif
722742emptyHscEnv nc libDir = do
723743 env <- runGhc (Just libDir) getSession
724744 initDynLinker env
@@ -757,7 +777,11 @@ toFlagsMap TargetDetails{..} =
757777 [ (l, (targetEnv, targetDepends)) | l <- targetLocations]
758778
759779
780+ #if MIN_VERSION_ghc(9,3,0)
781+ setNameCache :: NameCache -> HscEnv -> HscEnv
782+ #else
760783setNameCache :: IORef NameCache -> HscEnv -> HscEnv
784+ #endif
761785setNameCache nc hsc = hsc { hsc_NC = nc }
762786
763787-- | Create a mapping from FilePaths to HscEnvEqs
@@ -773,6 +797,11 @@ newComponentCache
773797newComponentCache recorder exts cradlePath cfp hsc_env uids ci = do
774798 let df = componentDynFlags ci
775799 hscEnv' <-
800+ #if MIN_VERSION_ghc(9,3,0)
801+ -- Set up a multi component session with the other units on GHC 9.4
802+ Compat. initUnits (map snd uids) (hscSetFlags df hsc_env)
803+ #elif MIN_VERSION_ghc(9,2,0)
804+ -- This initializes the units for GHC 9.2
776805 -- Add the options for the current component to the HscEnv
777806 -- We want to call `setSessionDynFlags` instead of `hscSetFlags`
778807 -- because `setSessionDynFlags` also initializes the package database,
@@ -782,14 +811,18 @@ newComponentCache recorder exts cradlePath cfp hsc_env uids ci = do
782811 evalGhcEnv hsc_env $ do
783812 _ <- setSessionDynFlags $ df
784813 getSession
785-
814+ #else
815+ -- getOptions is enough to initialize units on GHC <9.2
816+ pure $ hscSetFlags df hsc_env { hsc_IC = (hsc_IC hsc_env) { ic_dflags = df } }
817+ #endif
786818
787819 let newFunc = maybe newHscEnvEqPreserveImportPaths newHscEnvEq cradlePath
788820 henv <- newFunc hscEnv' uids
789821 let targetEnv = ([] , Just henv)
790822 targetDepends = componentDependencyInfo ci
791823 res = (targetEnv, targetDepends)
792824 logWith recorder Debug $ LogNewComponentCache res
825+ evaluate $ liftRnf rwhnf $ componentTargets ci
793826
794827 let mk t = fromTargetId (importPaths df) exts (targetId t) targetEnv targetDepends
795828 ctargets <- concatMapM mk (componentTargets ci)
@@ -998,9 +1031,11 @@ setOptions (ComponentOptions theOpts compRoot _) dflags = do
9981031 -- initPackages parses the -package flags and
9991032 -- sets up the visibility for each component.
10001033 -- Throws if a -package flag cannot be satisfied.
1001- env <- hscSetFlags dflags'' <$> getSession
1002- final_env' <- liftIO $ wrapPackageSetupException $ Compat. initUnits env
1003- return (hsc_dflags final_env', targets)
1034+ -- This only works for GHC <9.2
1035+ -- For GHC >= 9.2, we need to modify the unit env in the hsc_dflags, which
1036+ -- is done later in newComponentCache
1037+ final_flags <- liftIO $ wrapPackageSetupException $ Compat. oldInitUnits dflags''
1038+ return (final_flags, targets)
10041039
10051040setIgnoreInterfacePragmas :: DynFlags -> DynFlags
10061041setIgnoreInterfacePragmas df =
0 commit comments