1
1
{-# LANGUAGE ExistentialQuantification #-}
2
2
{-# LANGUAGE RankNTypes #-}
3
3
{-# LANGUAGE TypeFamilies #-}
4
+ {-# LANGUAGE CPP #-}
4
5
5
6
{-|
6
7
The logic for setting up a ghcide session by tapping into hie-bios.
@@ -100,6 +101,9 @@ import HieDb.Utils
100
101
import System.Random (RandomGen )
101
102
import qualified System.Random as Random
102
103
import Control.Monad.IO.Unlift (MonadUnliftIO )
104
+ import Debug.Trace
105
+ import Control.Exception (evaluate )
106
+ import Control.DeepSeq
103
107
104
108
data Log
105
109
= LogSettingInitialDynFlags
@@ -208,11 +212,13 @@ data SessionLoadingOptions = SessionLoadingOptions
208
212
, getCacheDirs :: String -> [String ] -> IO CacheDirs
209
213
-- | Return the GHC lib dir to use for the 'unsafeGlobalDynFlags'
210
214
, getInitialGhcLibDir :: Recorder (WithPriority Log ) -> FilePath -> IO (Maybe LibDir )
215
+ # if ! MIN_VERSION_ghc (9 ,3 ,0 )
211
216
, fakeUid :: UnitId
212
217
-- ^ unit id used to tag the internal component built by ghcide
213
218
-- To reuse external interface files the unit ids must match,
214
219
-- thus make sure to build them with `--this-unit-id` set to the
215
220
-- same value as the ghcide fake uid
221
+ # endif
216
222
}
217
223
218
224
instance Default SessionLoadingOptions where
@@ -221,7 +227,9 @@ instance Default SessionLoadingOptions where
221
227
,loadCradle = loadWithImplicitCradle
222
228
,getCacheDirs = getCacheDirsDefault
223
229
,getInitialGhcLibDir = getInitialGhcLibDirDefault
230
+ #if !MIN_VERSION_ghc(9,3,0)
224
231
,fakeUid = Compat. toUnitId (Compat. stringToUnit " main" )
232
+ #endif
225
233
}
226
234
227
235
-- | Find the cradle for a given 'hie.yaml' configuration.
@@ -494,7 +502,11 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
494
502
new_deps' <- forM new_deps $ \ RawComponentInfo {.. } -> do
495
503
-- Remove all inplace dependencies from package flags for
496
504
-- components in this HscEnv
505
+ #if MIN_VERSION_ghc(9,3,0)
506
+ let (df2, uids) = (rawComponentDynFlags, [] )
507
+ #else
497
508
let (df2, uids) = removeInplacePackages fakeUid inplace rawComponentDynFlags
509
+ #endif
498
510
let prefix = show rawComponentUnitId
499
511
-- See Note [Avoiding bad interface files]
500
512
let hscComponents = sort $ map show uids
@@ -517,10 +529,14 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
517
529
-- that I do not fully understand
518
530
log Info $ LogMakingNewHscEnv inplace
519
531
hscEnv <- emptyHscEnv ideNc libDir
520
- newHscEnv <-
532
+ ! newHscEnv <-
521
533
-- Add the options for the current component to the HscEnv
522
534
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
524
540
getSession
525
541
526
542
-- Modify the map so the hieYaml now maps to the newly created
@@ -718,7 +734,11 @@ cradleToOptsAndLibDir recorder cradle file = do
718
734
logWith recorder Info $ LogNoneCradleFound file
719
735
return (Left [] )
720
736
737
+ #if MIN_VERSION_ghc(9,3,0)
738
+ emptyHscEnv :: NameCache -> FilePath -> IO HscEnv
739
+ #else
721
740
emptyHscEnv :: IORef NameCache -> FilePath -> IO HscEnv
741
+ #endif
722
742
emptyHscEnv nc libDir = do
723
743
env <- runGhc (Just libDir) getSession
724
744
initDynLinker env
@@ -757,7 +777,11 @@ toFlagsMap TargetDetails{..} =
757
777
[ (l, (targetEnv, targetDepends)) | l <- targetLocations]
758
778
759
779
780
+ #if MIN_VERSION_ghc(9,3,0)
781
+ setNameCache :: NameCache -> HscEnv -> HscEnv
782
+ #else
760
783
setNameCache :: IORef NameCache -> HscEnv -> HscEnv
784
+ #endif
761
785
setNameCache nc hsc = hsc { hsc_NC = nc }
762
786
763
787
-- | Create a mapping from FilePaths to HscEnvEqs
@@ -773,6 +797,11 @@ newComponentCache
773
797
newComponentCache recorder exts cradlePath cfp hsc_env uids ci = do
774
798
let df = componentDynFlags ci
775
799
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,3,0)
804
+ -- This initializes the units for GHC 9.2
776
805
-- Add the options for the current component to the HscEnv
777
806
-- We want to call `setSessionDynFlags` instead of `hscSetFlags`
778
807
-- because `setSessionDynFlags` also initializes the package database,
@@ -782,14 +811,20 @@ newComponentCache recorder exts cradlePath cfp hsc_env uids ci = do
782
811
evalGhcEnv hsc_env $ do
783
812
_ <- setSessionDynFlags $ df
784
813
getSession
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
785
818
819
+ traceM " got new hsc env"
786
820
787
821
let newFunc = maybe newHscEnvEqPreserveImportPaths newHscEnvEq cradlePath
788
822
henv <- newFunc hscEnv' uids
789
823
let targetEnv = ([] , Just henv)
790
824
targetDepends = componentDependencyInfo ci
791
825
res = (targetEnv, targetDepends)
792
826
logWith recorder Debug $ LogNewComponentCache res
827
+ evaluate $ liftRnf rwhnf $ componentTargets ci
793
828
794
829
let mk t = fromTargetId (importPaths df) exts (targetId t) targetEnv targetDepends
795
830
ctargets <- concatMapM mk (componentTargets ci)
@@ -998,9 +1033,11 @@ setOptions (ComponentOptions theOpts compRoot _) dflags = do
998
1033
-- initPackages parses the -package flags and
999
1034
-- sets up the visibility for each component.
1000
1035
-- 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)
1036
+ -- This only works for GHC <9.2
1037
+ -- For GHC >= 9.2, we need to modify the unit env in the hsc_dflags, which
1038
+ -- is done later in newComponentCache
1039
+ final_flags <- liftIO $ wrapPackageSetupException $ Compat. oldInitUnits dflags''
1040
+ return (final_flags, targets)
1004
1041
1005
1042
setIgnoreInterfacePragmas :: DynFlags -> DynFlags
1006
1043
setIgnoreInterfacePragmas df =
0 commit comments