mirror of
https://github.com/haskell/haskell-language-server.git
synced 2024-09-11 08:45:35 +03:00
WIP evaluate CPP
This commit is contained in:
Michael Peyton Jones
parent
287ee42ab5
commit
a478a75c29
@ -120,7 +120,6 @@ import Text.ParserCombinators.ReadP (readP_to_S)
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import qualified Data.Set as OS
|
||||
import qualified Development.IDE.GHC.Compat.Util as Compat
|
||||
import GHC.Data.Graph.Directed
|
||||
@ -131,7 +130,6 @@ import GHC.Driver.Errors.Types
|
||||
import GHC.Types.Error (errMsgDiagnostic,
|
||||
singleMessage)
|
||||
import GHC.Unit.State
|
||||
#endif
|
||||
|
||||
data Log
|
||||
= LogSettingInitialDynFlags
|
||||
@ -245,13 +243,6 @@ data SessionLoadingOptions = SessionLoadingOptions
|
||||
, getCacheDirs :: String -> [String] -> IO CacheDirs
|
||||
-- | Return the GHC lib dir to use for the 'unsafeGlobalDynFlags'
|
||||
, getInitialGhcLibDir :: Recorder (WithPriority Log) -> FilePath -> IO (Maybe LibDir)
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
, fakeUid :: UnitId
|
||||
-- ^ unit id used to tag the internal component built by ghcide
|
||||
-- To reuse external interface files the unit ids must match,
|
||||
-- thus make sure to build them with `--this-unit-id` set to the
|
||||
-- same value as the ghcide fake uid
|
||||
#endif
|
||||
}
|
||||
|
||||
instance Default SessionLoadingOptions where
|
||||
@ -260,9 +251,6 @@ instance Default SessionLoadingOptions where
|
||||
,loadCradle = loadWithImplicitCradle
|
||||
,getCacheDirs = getCacheDirsDefault
|
||||
,getInitialGhcLibDir = getInitialGhcLibDirDefault
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
,fakeUid = Compat.toUnitId (Compat.stringToUnit "main")
|
||||
#endif
|
||||
}
|
||||
|
||||
-- | Find the cradle for a given 'hie.yaml' configuration.
|
||||
@ -542,11 +530,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
|
||||
all_deps' <- forM all_deps $ \RawComponentInfo{..} -> do
|
||||
-- Remove all inplace dependencies from package flags for
|
||||
-- components in this HscEnv
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
let (df2, uids) = (rawComponentDynFlags, [])
|
||||
#else
|
||||
let (df2, uids) = _removeInplacePackages fakeUid _inplace rawComponentDynFlags
|
||||
#endif
|
||||
let prefix = show rawComponentUnitId
|
||||
-- See Note [Avoiding bad interface files]
|
||||
let hscComponents = sort $ map show uids
|
||||
@ -771,11 +755,7 @@ cradleToOptsAndLibDir recorder loadConfig cradle file old_fps = do
|
||||
PreferSingleComponentLoading -> LoadFile
|
||||
PreferMultiComponentLoading -> LoadWithContext old_fps
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
emptyHscEnv :: NameCache -> FilePath -> IO HscEnv
|
||||
#else
|
||||
emptyHscEnv :: IORef NameCache -> FilePath -> IO HscEnv
|
||||
#endif
|
||||
emptyHscEnv nc libDir = do
|
||||
-- We call setSessionDynFlags so that the loader is initialised
|
||||
-- We need to do this before we call initUnits.
|
||||
@ -786,9 +766,6 @@ emptyHscEnv nc libDir = do
|
||||
-- package database subsequently. So clear the unit db cache in
|
||||
-- hsc_unit_dbs
|
||||
pure $ setNameCache nc (hscSetFlags ((hsc_dflags env){useUnicode = True }) env)
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
{hsc_unit_dbs = Nothing}
|
||||
#endif
|
||||
|
||||
data TargetDetails = TargetDetails
|
||||
{
|
||||
@ -826,14 +803,9 @@ toFlagsMap TargetDetails{..} =
|
||||
[ (l, (targetEnv, targetDepends)) | l <- targetLocations]
|
||||
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
setNameCache :: NameCache -> HscEnv -> HscEnv
|
||||
#else
|
||||
setNameCache :: IORef NameCache -> HscEnv -> HscEnv
|
||||
#endif
|
||||
setNameCache nc hsc = hsc { hsc_NC = nc }
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
-- This function checks the important property that if both p and q are home units
|
||||
-- then any dependency of p, which transitively depends on q is also a home unit.
|
||||
-- GHC had an implementation of this function, but it was horribly inefficient
|
||||
@ -890,7 +862,6 @@ checkHomeUnitsClosed' ue home_id_set
|
||||
Just depends ->
|
||||
let todo'' = (depends OS.\\ done) `OS.union` todo'
|
||||
in DigraphNode uid uid (OS.toList depends) : go (OS.insert uid done) todo''
|
||||
#endif
|
||||
|
||||
-- | Create a mapping from FilePaths to HscEnvEqs
|
||||
-- This combines all the components we know about into
|
||||
@ -920,7 +891,6 @@ newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis dir = do
|
||||
hscEnv' <- -- Set up a multi component session with the other units on GHC 9.4
|
||||
Compat.initUnits dfs hsc_env
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
let closure_errs = checkHomeUnitsClosed' (hsc_unit_env hscEnv') (hsc_all_home_unit_ids hscEnv')
|
||||
multi_errs = map (ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Warning) _cfp . T.pack . Compat.printWithoutUniques) closure_errs
|
||||
bad_units = OS.fromList $ concat $ do
|
||||
@ -928,10 +898,6 @@ newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis dir = do
|
||||
DriverHomePackagesNotClosed us <- pure x
|
||||
pure us
|
||||
isBad ci = (homeUnitId_ (componentDynFlags ci)) `OS.member` bad_units
|
||||
#else
|
||||
let isBad = const False
|
||||
multi_errs = []
|
||||
#endif
|
||||
-- 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
|
||||
-- case the interactive session will fail when trying to load
|
||||
@ -953,23 +919,10 @@ newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis dir = do
|
||||
let df = componentDynFlags ci
|
||||
let createHscEnvEq = maybe newHscEnvEqPreserveImportPaths (newHscEnvEq dir) cradlePath
|
||||
thisEnv <- do
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
-- In GHC 9.4 we have multi component support, and we have initialised all the units
|
||||
-- above.
|
||||
-- We just need to set the current unit here
|
||||
pure $ hscSetActiveUnitId (homeUnitId_ df) hscEnv'
|
||||
#else
|
||||
-- This initializes the units for GHC 9.2
|
||||
-- Add the options for the current component to the HscEnv
|
||||
-- We want to call `setSessionDynFlags` instead of `hscSetFlags`
|
||||
-- because `setSessionDynFlags` also initializes the package database,
|
||||
-- which we need for any changes to the package flags in the dynflags
|
||||
-- to be visible.
|
||||
-- See #2693
|
||||
evalGhcEnv hscEnv' $ do
|
||||
_ <- setSessionDynFlags df
|
||||
getSession
|
||||
#endif
|
||||
henv <- createHscEnvEq thisEnv (zip uids dfs)
|
||||
let targetEnv = (if isBad ci then multi_errs else [], Just henv)
|
||||
targetDepends = componentDependencyInfo ci
|
||||
@ -1201,7 +1154,6 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags rootDir = do
|
||||
initOne this_opts = do
|
||||
(dflags', targets') <- addCmdOpts this_opts dflags
|
||||
let dflags'' =
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
case unitIdString (homeUnitId_ dflags') of
|
||||
-- cabal uses main for the unit id of all executable packages
|
||||
-- This makes multi-component sessions confused about what
|
||||
@ -1214,9 +1166,6 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags rootDir = do
|
||||
hashed_uid = Compat.toUnitId (Compat.stringToUnit ("main-"++hash))
|
||||
in setHomeUnitId_ hashed_uid dflags'
|
||||
_ -> dflags'
|
||||
#else
|
||||
dflags'
|
||||
#endif
|
||||
|
||||
let targets = makeTargetsAbsolute root targets'
|
||||
root = case workingDirectory dflags'' of
|
||||
|
||||
@ -111,15 +111,8 @@ import GHC.Types.TypeEnv
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
import Data.Map (Map)
|
||||
import GHC.Unit.Module.Graph (ModuleGraph)
|
||||
import Unsafe.Coerce
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import qualified Data.Set as Set
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,5,0)
|
||||
import GHC.Core.Lint.Interactive
|
||||
@ -223,11 +216,7 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do
|
||||
-- come from in the IORef,, as these are the modules on whose implementation
|
||||
-- we depend.
|
||||
compile_bco_hook :: IORef (ModuleEnv BS.ByteString) -> HscEnv -> SrcSpan -> CoreExpr
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
-> IO (ForeignHValue, [Linkable], PkgsLoaded)
|
||||
#else
|
||||
-> IO ForeignHValue
|
||||
#endif
|
||||
compile_bco_hook var hsc_env srcspan ds_expr
|
||||
= do { let dflags = hsc_dflags hsc_env
|
||||
|
||||
@ -247,10 +236,8 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do
|
||||
; let iNTERACTIVELoc = G.ModLocation{ ml_hs_file = Nothing,
|
||||
ml_hi_file = panic "hscCompileCoreExpr':ml_hi_file",
|
||||
ml_obj_file = panic "hscCompileCoreExpr':ml_obj_file",
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
ml_dyn_obj_file = panic "hscCompileCoreExpr':ml_dyn_obj_file",
|
||||
ml_dyn_hi_file = panic "hscCompileCoreExpr':ml_dyn_hi_file",
|
||||
#endif
|
||||
ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file"
|
||||
}
|
||||
; let ictxt = hsc_IC hsc_env
|
||||
@ -259,9 +246,7 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do
|
||||
myCoreToStgExpr (hsc_logger hsc_env)
|
||||
(hsc_dflags hsc_env)
|
||||
ictxt
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
True -- for bytecode
|
||||
#endif
|
||||
(icInteractiveModule ictxt)
|
||||
iNTERACTIVELoc
|
||||
prepd_expr
|
||||
@ -279,11 +264,7 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do
|
||||
|
||||
-- Find the linkables for the modules we need
|
||||
; let needed_mods = mkUniqSet [
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
mod -- We need the whole module for 9.4 because of multiple home units modules may have different unit ids
|
||||
#else
|
||||
moduleName mod -- On <= 9.2, just the name is enough because all unit ids will be the same
|
||||
#endif
|
||||
|
||||
| n <- concatMap (uniqDSetToList . bcoFreeNames) $ bc_bcos bcos
|
||||
, not (isWiredInName n) -- Exclude wired-in names
|
||||
@ -291,27 +272,14 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do
|
||||
, moduleUnitId mod `elem` home_unit_ids -- Only care about stuff from the home package set
|
||||
]
|
||||
home_unit_ids =
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
map fst (hugElts $ hsc_HUG hsc_env)
|
||||
#else
|
||||
[homeUnitId_ dflags]
|
||||
#endif
|
||||
mods_transitive = getTransitiveMods hsc_env needed_mods
|
||||
|
||||
-- If we don't support multiple home units, ModuleNames are sufficient because all the units will be the same
|
||||
mods_transitive_list =
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
mapMaybe nodeKeyToInstalledModule $ Set.toList mods_transitive
|
||||
#else
|
||||
-- Non det OK as we will put it into maps later anyway
|
||||
map (Compat.installedModule (homeUnitId_ dflags)) $ nonDetEltsUniqSet mods_transitive
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
; moduleLocs <- readIORef (fcModuleCache $ hsc_FC hsc_env)
|
||||
#else
|
||||
; moduleLocs <- readIORef (hsc_FC hsc_env)
|
||||
#endif
|
||||
; lbs <- getLinkables [toNormalizedFilePath' file
|
||||
| installedMod <- mods_transitive_list
|
||||
, let ifr = fromJust $ lookupInstalledModuleEnv moduleLocs installedMod
|
||||
@ -322,20 +290,13 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do
|
||||
]
|
||||
; let hsc_env' = loadModulesHome (map linkableHomeMod lbs) hsc_env
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
{- load it -}
|
||||
; (fv_hvs, lbss, pkgs) <- loadDecls (hscInterp hsc_env') hsc_env' srcspan bcos
|
||||
; let hval = ((expectJust "hscCompileCoreExpr'" $ lookup (idName binding_id) fv_hvs), lbss, pkgs)
|
||||
#else
|
||||
{- load it -}
|
||||
; fv_hvs <- loadDecls (hscInterp hsc_env') hsc_env' srcspan bcos
|
||||
; let hval = expectJust "hscCompileCoreExpr'" $ lookup (idName binding_id) fv_hvs
|
||||
#endif
|
||||
|
||||
; modifyIORef' var (flip extendModuleEnvList [(mi_module $ hm_iface hm, linkableHash lb) | lb <- lbs, let hm = linkableHomeMod lb])
|
||||
; return hval }
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
-- TODO: support backpack
|
||||
nodeKeyToInstalledModule :: NodeKey -> Maybe InstalledModule
|
||||
-- We shouldn't get boot files here, but to be safe, never map them to an installed module
|
||||
@ -346,28 +307,13 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do
|
||||
nodeKeyToInstalledModule _ = Nothing
|
||||
moduleToNodeKey :: Module -> NodeKey
|
||||
moduleToNodeKey mod = NodeKey_Module $ ModNodeKeyWithUid (GWIB (moduleName mod) NotBoot) (moduleUnitId mod)
|
||||
#endif
|
||||
|
||||
-- Compute the transitive set of linkables required
|
||||
getTransitiveMods hsc_env needed_mods
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
= Set.unions (Set.fromList (map moduleToNodeKey mods) : [ dep | m <- mods
|
||||
, Just dep <- [Map.lookup (moduleToNodeKey m) (mgTransDeps (hsc_mod_graph hsc_env))]
|
||||
])
|
||||
where mods = nonDetEltsUniqSet needed_mods -- OK because we put them into a set immediately after
|
||||
#else
|
||||
= go emptyUniqSet needed_mods
|
||||
where
|
||||
hpt = hsc_HPT hsc_env
|
||||
go seen new
|
||||
| isEmptyUniqSet new = seen
|
||||
| otherwise = go seen' new'
|
||||
where
|
||||
seen' = seen `unionUniqSets` new
|
||||
new' = new_deps `minusUniqSet` seen'
|
||||
new_deps = unionManyUniqSets [ mkUniqSet $ getDependentMods $ hm_iface mod_info
|
||||
| mod_info <- eltsUDFM $ udfmIntersectUFM hpt (getUniqSet new)]
|
||||
#endif
|
||||
|
||||
-- | Add a Hook to the DynFlags which captures and returns the
|
||||
-- typechecked splices before they are run. This information
|
||||
@ -442,12 +388,8 @@ tcRnModule hsc_env tc_helpers pmod = do
|
||||
-- HLS. To avoid GHC from pessimising HLS, we filter out certain dependency information
|
||||
-- that we track ourselves. See also Note [Recompilation avoidance in the presence of TH]
|
||||
filterUsages :: [Usage] -> [Usage]
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
filterUsages = filter $ \case UsageHomeModuleInterface{} -> False
|
||||
_ -> True
|
||||
#else
|
||||
filterUsages = id
|
||||
#endif
|
||||
|
||||
-- | Mitigation for https://gitlab.haskell.org/ghc/ghc/-/issues/22744
|
||||
-- Important to do this immediately after reading the unit before
|
||||
@ -498,9 +440,7 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do
|
||||
(cg_binds guts)
|
||||
#endif
|
||||
details
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
ms
|
||||
#endif
|
||||
simplified_guts
|
||||
|
||||
final_iface' <- mkFullIface session partial_iface Nothing
|
||||
@ -552,17 +492,9 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do
|
||||
|
||||
-- Run corePrep first as we want to test the final version of the program that will
|
||||
-- get translated to STG/Bytecode
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
prepd_binds
|
||||
#else
|
||||
(prepd_binds , _)
|
||||
#endif
|
||||
<- corePrep unprep_binds data_tycons
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
prepd_binds'
|
||||
#else
|
||||
(prepd_binds', _)
|
||||
#endif
|
||||
<- corePrep unprep_binds' data_tycons
|
||||
let binds = noUnfoldings $ (map flattenBinds . (:[])) prepd_binds
|
||||
binds' = noUnfoldings $ (map flattenBinds . (:[])) prepd_binds'
|
||||
@ -659,11 +591,7 @@ generateObjectCode session summary guts = do
|
||||
let env' = tweak (hscSetFlags (ms_hspp_opts summary) session)
|
||||
target = platformDefaultBackend (hsc_dflags env')
|
||||
newFlags = setBackend target $ updOptLevel 0 $ setOutputFile
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
(Just dot_o)
|
||||
#else
|
||||
dot_o
|
||||
#endif
|
||||
$ hsc_dflags env'
|
||||
session' = hscSetFlags newFlags session
|
||||
#if MIN_VERSION_ghc(9,4,2)
|
||||
@ -674,13 +602,9 @@ generateObjectCode session summary guts = do
|
||||
(ms_location summary)
|
||||
fp
|
||||
obj <- compileFile session' driverNoStop (outputFilename, Just (As False))
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
case obj of
|
||||
Nothing -> throwGhcExceptionIO $ Panic "compileFile didn't generate object code"
|
||||
Just x -> pure x
|
||||
#else
|
||||
return obj
|
||||
#endif
|
||||
let unlinked = DotO dot_o_fp
|
||||
-- Need time to be the modification time for recompilation checking
|
||||
t <- liftIO $ getModificationTime dot_o_fp
|
||||
@ -725,17 +649,10 @@ update_pm_mod_summary :: (ModSummary -> ModSummary) -> ParsedModule -> ParsedMod
|
||||
update_pm_mod_summary up pm =
|
||||
pm{pm_mod_summary = up $ pm_mod_summary pm}
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
unDefer :: (Maybe DiagnosticReason, FileDiagnostic) -> (Bool, FileDiagnostic)
|
||||
unDefer (Just (WarningWithFlag Opt_WarnDeferredTypeErrors) , fd) = (True, upgradeWarningToError fd)
|
||||
unDefer (Just (WarningWithFlag Opt_WarnTypedHoles) , fd) = (True, upgradeWarningToError fd)
|
||||
unDefer (Just (WarningWithFlag Opt_WarnDeferredOutOfScopeVariables), fd) = (True, upgradeWarningToError fd)
|
||||
#else
|
||||
unDefer :: (WarnReason, FileDiagnostic) -> (Bool, FileDiagnostic)
|
||||
unDefer (Reason Opt_WarnDeferredTypeErrors , fd) = (True, upgradeWarningToError fd)
|
||||
unDefer (Reason Opt_WarnTypedHoles , fd) = (True, upgradeWarningToError fd)
|
||||
unDefer (Reason Opt_WarnDeferredOutOfScopeVariables, fd) = (True, upgradeWarningToError fd)
|
||||
#endif
|
||||
unDefer ( _ , fd) = (False, fd)
|
||||
|
||||
upgradeWarningToError :: FileDiagnostic -> FileDiagnostic
|
||||
@ -744,13 +661,8 @@ upgradeWarningToError (nfp, sh, fd) =
|
||||
warn2err :: T.Text -> T.Text
|
||||
warn2err = T.intercalate ": error:" . T.splitOn ": warning:"
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
hideDiag :: DynFlags -> (Maybe DiagnosticReason, FileDiagnostic) -> (Maybe DiagnosticReason, FileDiagnostic)
|
||||
hideDiag originalFlags (w@(Just (WarningWithFlag warning)), (nfp, _sh, fd))
|
||||
#else
|
||||
hideDiag :: DynFlags -> (WarnReason, FileDiagnostic) -> (WarnReason, FileDiagnostic)
|
||||
hideDiag originalFlags (w@(Reason warning), (nfp, _sh, fd))
|
||||
#endif
|
||||
| not (wopt warning originalFlags)
|
||||
= (w, (nfp, HideDiag, fd))
|
||||
hideDiag _originalFlags t = t
|
||||
@ -773,11 +685,7 @@ unnecessaryDeprecationWarningFlags
|
||||
]
|
||||
|
||||
-- | Add a unnecessary/deprecated tag to the required diagnostics.
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
tagDiag :: (Maybe DiagnosticReason, FileDiagnostic) -> (Maybe DiagnosticReason, FileDiagnostic)
|
||||
#else
|
||||
tagDiag :: (WarnReason, FileDiagnostic) -> (WarnReason, FileDiagnostic)
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,7,0)
|
||||
tagDiag (w@(Just (WarningWithCategory cat)), (nfp, sh, fd))
|
||||
@ -786,12 +694,8 @@ tagDiag (w@(Just (WarningWithCategory cat)), (nfp, sh, fd))
|
||||
tagDiag (w@(Just (WarningWithFlags warnings)), (nfp, sh, fd))
|
||||
| tags <- mapMaybe requiresTag (toList warnings)
|
||||
= (w, (nfp, sh, fd { _tags = Just $ tags ++ concat (_tags fd) }))
|
||||
#elif MIN_VERSION_ghc(9,3,0)
|
||||
tagDiag (w@(Just (WarningWithFlag warning)), (nfp, sh, fd))
|
||||
| Just tag <- requiresTag warning
|
||||
= (w, (nfp, sh, fd { _tags = Just $ tag : concat (_tags fd) }))
|
||||
#else
|
||||
tagDiag (w@(Reason warning), (nfp, sh, fd))
|
||||
tagDiag (w@(Just (WarningWithFlag warning)), (nfp, sh, fd))
|
||||
| Just tag <- requiresTag warning
|
||||
= (w, (nfp, sh, fd { _tags = Just $ tag : concat (_tags fd) }))
|
||||
#endif
|
||||
@ -835,20 +739,12 @@ generateHieAsts hscEnv tcm =
|
||||
insts = tcg_insts ts :: [ClsInst]
|
||||
tcs = tcg_tcs ts :: [TyCon]
|
||||
run ts $
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
pure $ Just $
|
||||
#else
|
||||
Just <$>
|
||||
#endif
|
||||
GHC.enrichHie (fake_splice_binds `Util.unionBags` real_binds) (tmrRenamed tcm) top_ev_binds insts tcs
|
||||
where
|
||||
dflags = hsc_dflags hscEnv
|
||||
run _ts = -- ts is only used in GHC 9.2
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
fmap (join . snd) . liftIO . initDs hscEnv _ts
|
||||
#else
|
||||
id
|
||||
#endif
|
||||
|
||||
spliceExpressions :: Splices -> [LHsExpr GhcTc]
|
||||
spliceExpressions Splices{..} =
|
||||
@ -1048,7 +944,6 @@ handleGenerationErrors' dflags source action =
|
||||
-- transitive dependencies will be contained in envs)
|
||||
mergeEnvs :: HscEnv -> ModuleGraph -> ModSummary -> [HomeModInfo] -> [HscEnv] -> IO HscEnv
|
||||
mergeEnvs env mg ms extraMods envs = do
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
let im = Compat.installedModule (toUnitId $ moduleUnit $ ms_mod ms) (moduleName (ms_mod ms))
|
||||
ifr = InstalledFound (ms_location ms) im
|
||||
curFinderCache = Compat.extendInstalledModuleEnv Compat.emptyInstalledModuleEnv im ifr
|
||||
@ -1083,31 +978,6 @@ mergeEnvs env mg ms extraMods envs = do
|
||||
fcFiles' <- newIORef $! Map.unions fcFiles
|
||||
pure $ FinderCache fcModules' fcFiles'
|
||||
|
||||
#else
|
||||
prevFinderCache <- concatFC <$> mapM (readIORef . hsc_FC) envs
|
||||
let im = Compat.installedModule (toUnitId $ moduleUnit $ ms_mod ms) (moduleName (ms_mod ms))
|
||||
ifr = InstalledFound (ms_location ms) im
|
||||
newFinderCache <- newIORef $! Compat.extendInstalledModuleEnv prevFinderCache im ifr
|
||||
return $! loadModulesHome extraMods $
|
||||
env{
|
||||
hsc_HPT = foldMapBy mergeUDFM emptyUDFM hsc_HPT envs,
|
||||
hsc_FC = newFinderCache,
|
||||
hsc_mod_graph = mg
|
||||
}
|
||||
|
||||
where
|
||||
mergeUDFM = plusUDFM_C combineModules
|
||||
combineModules a b
|
||||
| HsSrcFile <- mi_hsc_src (hm_iface a) = a
|
||||
| otherwise = b
|
||||
-- required because 'FinderCache':
|
||||
-- 1) doesn't have a 'Monoid' instance,
|
||||
-- 2) is abstract and doesn't export constructors
|
||||
-- To work around this, we coerce to the underlying type
|
||||
-- To remove this, I plan to upstream the missing Monoid instance
|
||||
concatFC :: [FinderCache] -> FinderCache
|
||||
concatFC = unsafeCoerce (mconcat @(Map InstalledModule InstalledFindResult))
|
||||
#endif
|
||||
|
||||
withBootSuffix :: HscSource -> ModLocation -> ModLocation
|
||||
withBootSuffix HsBootFile = addBootSuffixLocnOut
|
||||
@ -1152,24 +1022,16 @@ getModSummaryFromImports env fp _modTime mContents = do
|
||||
|
||||
|
||||
convImport (L _ i) = (
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
fmap sl_fs
|
||||
#endif
|
||||
(ideclPkgQual i)
|
||||
, reLoc $ ideclName i)
|
||||
|
||||
msrImports = implicit_imports ++ imps
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
rn_pkg_qual = renameRawPkgQual (hsc_unit_env ppEnv)
|
||||
rn_imps = fmap (\(pk, lmn@(L _ mn)) -> (rn_pkg_qual mn pk, lmn))
|
||||
srcImports = rn_imps $ map convImport src_idecls
|
||||
textualImports = rn_imps $ map convImport (implicit_imports ++ ordinary_imps)
|
||||
ghc_prim_import = not (null _ghc_prim_imports)
|
||||
#else
|
||||
srcImports = map convImport src_idecls
|
||||
textualImports = map convImport (implicit_imports ++ ordinary_imps)
|
||||
#endif
|
||||
|
||||
|
||||
-- Force bits that might keep the string buffer and DynFlags alive unnecessarily
|
||||
@ -1189,14 +1051,10 @@ getModSummaryFromImports env fp _modTime mContents = do
|
||||
ModSummary
|
||||
{ ms_mod = modl
|
||||
, ms_hie_date = Nothing
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
, ms_dyn_obj_date = Nothing
|
||||
, ms_ghc_prim_import = ghc_prim_import
|
||||
, ms_hs_hash = _src_hash
|
||||
|
||||
#else
|
||||
, ms_hs_date = _modTime
|
||||
#endif
|
||||
, ms_hsc_src = sourceType
|
||||
-- The contents are used by the GetModSummary rule
|
||||
, ms_hspp_buf = Just contents
|
||||
@ -1221,14 +1079,10 @@ getModSummaryFromImports env fp _modTime mContents = do
|
||||
put $ Util.uniq $ moduleNameFS $ moduleName ms_mod
|
||||
forM_ (ms_srcimps ++ ms_textual_imps) $ \(mb_p, m) -> do
|
||||
put $ Util.uniq $ moduleNameFS $ unLoc m
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
case mb_p of
|
||||
G.NoPkgQual -> pure ()
|
||||
G.ThisPkg uid -> put $ getKey $ getUnique uid
|
||||
G.OtherPkg uid -> put $ getKey $ getUnique uid
|
||||
#else
|
||||
whenJust mb_p $ put . Util.uniq
|
||||
#endif
|
||||
return $! Util.fingerprintFingerprints $
|
||||
[ Util.fingerprintString fp
|
||||
, fingerPrintImports
|
||||
@ -1323,11 +1177,7 @@ parseFileContents env customPreprocessor filename ms = do
|
||||
-- - filter out the .hs/.lhs source filename if we have one
|
||||
--
|
||||
let n_hspp = normalise filename
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
TempDir tmp_dir = tmpDir dflags
|
||||
#else
|
||||
tmp_dir = tmpDir dflags
|
||||
#endif
|
||||
srcs0 = nubOrd $ filter (not . (tmp_dir `isPrefixOf`))
|
||||
$ filter (/= n_hspp)
|
||||
$ map normalise
|
||||
@ -1474,12 +1324,7 @@ loadInterface session ms linkableNeeded RecompilationInfo{..} = do
|
||||
-- ncu and read_dflags are only used in GHC >= 9.4
|
||||
let _ncu = hsc_NC sessionWithMsDynFlags
|
||||
_read_dflags = hsc_dflags sessionWithMsDynFlags
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
read_result <- liftIO $ readIface _read_dflags _ncu mod iface_file
|
||||
#else
|
||||
read_result <- liftIO $ initIfaceCheck (text "readIface") sessionWithMsDynFlags
|
||||
$ readIface mod iface_file
|
||||
#endif
|
||||
case read_result of
|
||||
Util.Failed{} -> return Nothing
|
||||
-- important to call `shareUsages` here before checkOldIface
|
||||
@ -1489,13 +1334,9 @@ loadInterface session ms linkableNeeded RecompilationInfo{..} = do
|
||||
-- If mb_old_iface is nothing then checkOldIface will load it for us
|
||||
-- given that the source is unmodified
|
||||
(recomp_iface_reqd, mb_checked_iface)
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
<- liftIO $ checkOldIface sessionWithMsDynFlags ms _old_iface >>= \case
|
||||
UpToDateItem x -> pure (UpToDate, Just x)
|
||||
OutOfDateItem reason x -> pure (NeedsRecompile reason, x)
|
||||
#else
|
||||
<- liftIO $ checkOldIface sessionWithMsDynFlags ms _sourceMod mb_old_iface
|
||||
#endif
|
||||
|
||||
let do_regenerate _reason = withTrace "regenerate interface" $ \setTag -> do
|
||||
setTag "Module" $ moduleNameString $ moduleName mod
|
||||
@ -1550,11 +1391,7 @@ parseRuntimeDeps anns = mkModuleEnv $ mapMaybe go anns
|
||||
-- See Note [Recompilation avoidance in the presence of TH]
|
||||
checkLinkableDependencies :: MonadIO m => HscEnv -> ([NormalizedFilePath] -> m [BS.ByteString]) -> ModuleEnv BS.ByteString -> m (Maybe RecompileRequired)
|
||||
checkLinkableDependencies hsc_env get_linkable_hashes runtime_deps = do
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
moduleLocs <- liftIO $ readIORef (fcModuleCache $ hsc_FC hsc_env)
|
||||
#else
|
||||
moduleLocs <- liftIO $ readIORef (hsc_FC hsc_env)
|
||||
#endif
|
||||
let go (mod, hash) = do
|
||||
ifr <- lookupInstalledModuleEnv moduleLocs $ Compat.installedModule (toUnitId $ moduleUnit mod) (moduleName mod)
|
||||
case ifr of
|
||||
@ -1575,27 +1412,16 @@ checkLinkableDependencies hsc_env get_linkable_hashes runtime_deps = do
|
||||
|
||||
recompBecause :: String -> RecompileRequired
|
||||
recompBecause =
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
NeedsRecompile .
|
||||
#endif
|
||||
RecompBecause
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
. CustomReason
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
data SourceModified = SourceModified | SourceUnmodified deriving (Eq, Ord, Show)
|
||||
#endif
|
||||
|
||||
showReason :: RecompileRequired -> String
|
||||
showReason UpToDate = "UpToDate"
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
showReason (NeedsRecompile MustCompile) = "MustCompile"
|
||||
showReason (NeedsRecompile s) = printWithoutUniques s
|
||||
#else
|
||||
showReason MustCompile = "MustCompile"
|
||||
showReason (RecompBecause s) = s
|
||||
#endif
|
||||
|
||||
mkDetailsFromIface :: HscEnv -> ModIface -> IO ModDetails
|
||||
mkDetailsFromIface session iface = do
|
||||
@ -1610,11 +1436,7 @@ coreFileToCgGuts session iface details core_file = do
|
||||
this_mod = mi_module iface
|
||||
types_var <- newIORef (md_types details)
|
||||
let hsc_env' = hscUpdateHPT act (session {
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
hsc_type_env_vars = knotVarsFromModuleEnv (mkModuleEnv [(this_mod, types_var)])
|
||||
#else
|
||||
hsc_type_env_var = Just (this_mod, types_var)
|
||||
#endif
|
||||
})
|
||||
core_binds <- initIfaceCheck (text "l") hsc_env' $ typecheckCoreFile this_mod types_var core_file
|
||||
-- Implicit binds aren't saved, so we need to regenerate them ourselves.
|
||||
@ -1623,10 +1445,8 @@ coreFileToCgGuts session iface details core_file = do
|
||||
#if MIN_VERSION_ghc(9,5,0)
|
||||
-- In GHC 9.6, the implicit binds are tidied and part of core_binds
|
||||
pure $ CgGuts this_mod tyCons core_binds [] NoStubs [] mempty (emptyHpcInfo False) Nothing []
|
||||
#elif MIN_VERSION_ghc(9,3,0)
|
||||
pure $ CgGuts this_mod tyCons (_implicit_binds ++ core_binds) [] NoStubs [] mempty (emptyHpcInfo False) Nothing []
|
||||
#else
|
||||
pure $ CgGuts this_mod tyCons (_implicit_binds ++ core_binds) NoStubs [] [] (emptyHpcInfo False) Nothing []
|
||||
pure $ CgGuts this_mod tyCons (_implicit_binds ++ core_binds) [] NoStubs [] mempty (emptyHpcInfo False) Nothing []
|
||||
#endif
|
||||
|
||||
coreFileToLinkable :: LinkableType -> HscEnv -> ModSummary -> ModIface -> ModDetails -> CoreFile -> UTCTime -> IO ([FileDiagnostic], Maybe HomeModInfo)
|
||||
@ -1643,45 +1463,23 @@ coreFileToLinkable linkableType session ms iface details core_file t = do
|
||||
getDocsBatch
|
||||
:: HscEnv
|
||||
-> [Name]
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
-> IO [Either String (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))]
|
||||
#else
|
||||
-> IO [Either String (Maybe HsDocString, IntMap HsDocString)]
|
||||
#endif
|
||||
getDocsBatch hsc_env _names = do
|
||||
res <- initIfaceLoad hsc_env $ forM _names $ \name ->
|
||||
case nameModule_maybe name of
|
||||
Nothing -> return (Left $ NameHasNoModule name)
|
||||
Just mod -> do
|
||||
ModIface {
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
mi_docs = Just Docs{ docs_mod_hdr = mb_doc_hdr
|
||||
, docs_decls = dmap
|
||||
, docs_args = amap
|
||||
}
|
||||
#else
|
||||
mi_doc_hdr = mb_doc_hdr
|
||||
, mi_decl_docs = DeclDocMap dmap
|
||||
, mi_arg_docs = ArgDocMap amap
|
||||
#endif
|
||||
} <- loadSysInterface (text "getModuleInterface") mod
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
if isNothing mb_doc_hdr && isNullUniqMap dmap && isNullUniqMap amap
|
||||
#else
|
||||
if isNothing mb_doc_hdr && Map.null dmap && null amap
|
||||
#endif
|
||||
then pure (Left (NoDocsInIface mod $ compiled name))
|
||||
else pure (Right (
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
lookupUniqMap dmap name,
|
||||
#else
|
||||
Map.lookup name dmap ,
|
||||
#endif
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
lookupWithDefaultUniqMap amap mempty name))
|
||||
#else
|
||||
Map.findWithDefault mempty name amap))
|
||||
#endif
|
||||
return $ map (first $ T.unpack . printOutputable) res
|
||||
where
|
||||
compiled n =
|
||||
|
||||
@ -33,9 +33,7 @@ import System.IO.Extra
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import GHC.Utils.Logger (LogFlags (..))
|
||||
#endif
|
||||
|
||||
-- | Given a file and some contents, apply any necessary preprocessors,
|
||||
-- e.g. unlit/cpp. Return the resulting buffer and the DynFlags it implies.
|
||||
@ -88,11 +86,7 @@ preprocessor env filename mbContents = do
|
||||
where
|
||||
logAction :: IORef [CPPLog] -> LogActionCompat
|
||||
logAction cppLogs dflags _reason severity srcSpan _style msg = do
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
let cppLog = CPPLog (fromMaybe SevWarning severity) srcSpan $ T.pack $ renderWithContext (log_default_user_context dflags) msg
|
||||
#else
|
||||
let cppLog = CPPLog severity srcSpan $ T.pack $ showSDoc dflags msg
|
||||
#endif
|
||||
modifyIORef cppLogs (cppLog :)
|
||||
|
||||
|
||||
@ -152,11 +146,7 @@ parsePragmasIntoHscEnv
|
||||
-> Util.StringBuffer
|
||||
-> IO (Either [FileDiagnostic] ([String], HscEnv))
|
||||
parsePragmasIntoHscEnv env fp contents = catchSrcErrors dflags0 "pragmas" $ do
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
let (_warns,opts) = getOptions (initParserOpts dflags0) contents fp
|
||||
#else
|
||||
let opts = getOptions dflags0 contents fp
|
||||
#endif
|
||||
|
||||
-- Force bits that might keep the dflags and stringBuffer alive unnecessarily
|
||||
evaluate $ rnf opts
|
||||
|
||||
@ -171,13 +171,8 @@ import GHC.Fingerprint
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
import GHC (mgModSummaries)
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import qualified Data.IntMap as IM
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
@ -641,7 +636,6 @@ dependencyInfoForFiles fs = do
|
||||
let (all_fs, _all_ids) = unzip $ HM.toList $ pathToIdMap $ rawPathIdMap rawDepInfo
|
||||
msrs <- uses GetModSummaryWithoutTimestamps all_fs
|
||||
let mss = map (fmap msrModSummary) msrs
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
let deps = map (\i -> IM.lookup (getFilePathId i) (rawImports rawDepInfo)) _all_ids
|
||||
nodeKeys = IM.fromList $ catMaybes $ zipWith (\fi mms -> (getFilePathId fi,) . NodeKey_Module . msKey <$> mms) _all_ids mss
|
||||
mns = catMaybes $ zipWith go mss deps
|
||||
@ -651,14 +645,6 @@ dependencyInfoForFiles fs = do
|
||||
go (Just ms) _ = Just $ ModuleNode [] ms
|
||||
go _ _ = Nothing
|
||||
mg = mkModuleGraph mns
|
||||
#else
|
||||
let mg = mkModuleGraph $
|
||||
-- We don't do any instantiation for backpack at this point of time, so it is OK to use
|
||||
-- 'extendModSummaryNoDeps'.
|
||||
-- This may have to change in the future.
|
||||
map extendModSummaryNoDeps $
|
||||
catMaybes mss
|
||||
#endif
|
||||
pure (fingerprintToBS $ Util.fingerprintFingerprints $ map (maybe fingerprint0 msrFingerprint) msrs, processDependencyInformation rawDepInfo bm mg)
|
||||
|
||||
-- This is factored out so it can be directly called from the GetModIface
|
||||
@ -776,7 +762,6 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do
|
||||
then depModuleGraph <$> useNoFile_ GetModuleGraph
|
||||
else do
|
||||
let mgs = map hsc_mod_graph depSessions
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
-- On GHC 9.4+, the module graph contains not only ModSummary's but each `ModuleNode` in the graph
|
||||
-- also points to all the direct descendants of the current module. To get the keys for the descendants
|
||||
-- we must get their `ModSummary`s
|
||||
@ -785,14 +770,6 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do
|
||||
return $!! map (NodeKey_Module . msKey) dep_mss
|
||||
let module_graph_nodes =
|
||||
nubOrdOn mkNodeKey (ModuleNode final_deps ms : concatMap mgModSummaries' mgs)
|
||||
#else
|
||||
let module_graph_nodes =
|
||||
-- We don't do any instantiation for backpack at this point of time, so it is OK to use
|
||||
-- 'extendModSummaryNoDeps'.
|
||||
-- This may have to change in the future.
|
||||
map extendModSummaryNoDeps $
|
||||
nubOrdOn ms_mod (ms : concatMap mgModSummaries mgs)
|
||||
#endif
|
||||
liftIO $ evaluate $ liftRnf rwhnf module_graph_nodes
|
||||
return $ mkModuleGraph module_graph_nodes
|
||||
session' <- liftIO $ mergeEnvs hsc mg ms inLoadOrder depSessions
|
||||
@ -905,12 +882,7 @@ getModSummaryRule displayTHWarning recorder = do
|
||||
when (uses_th_qq $ msrModSummary res) $ do
|
||||
DisplayTHWarning act <- getIdeGlobalAction
|
||||
liftIO act
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
let bufFingerPrint = ms_hs_hash (msrModSummary res)
|
||||
#else
|
||||
bufFingerPrint <- liftIO $
|
||||
fingerprintFromStringBuffer $ fromJust $ ms_hspp_buf $ msrModSummary res
|
||||
#endif
|
||||
let fingerPrint = Util.fingerprintFingerprints
|
||||
[ msrFingerprint res, bufFingerPrint ]
|
||||
return ( Just (fingerprintToBS fingerPrint) , ([], Just res))
|
||||
@ -921,9 +893,6 @@ getModSummaryRule displayTHWarning recorder = do
|
||||
case mbMs of
|
||||
Just res@ModSummaryResult{..} -> do
|
||||
let ms = msrModSummary {
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
ms_hs_date = error "use GetModSummary instead of GetModSummaryWithoutTimestamps",
|
||||
#endif
|
||||
ms_hspp_buf = error "use GetModSummary instead of GetModSummaryWithoutTimestamps"
|
||||
}
|
||||
fp = fingerprintToBS msrFingerprint
|
||||
|
||||
@ -176,16 +176,8 @@ import System.Time.Extra
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
import Data.IORef
|
||||
import Development.IDE.GHC.Compat (NameCacheUpdater (NCU),
|
||||
mkSplitUniqSupply,
|
||||
upNameCache)
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import Development.IDE.GHC.Compat (NameCacheUpdater)
|
||||
#endif
|
||||
|
||||
data Log
|
||||
= LogCreateHieDbExportsMapStart
|
||||
@ -315,11 +307,7 @@ data ShakeExtras = ShakeExtras
|
||||
-> [DelayedAction ()]
|
||||
-> IO [Key]
|
||||
-> IO ()
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
,ideNc :: NameCache
|
||||
#else
|
||||
,ideNc :: IORef NameCache
|
||||
#endif
|
||||
-- | A mapping of module name to known target (or candidate targets, if missing)
|
||||
,knownTargetsVar :: TVar (Hashed KnownTargets)
|
||||
-- | A mapping of exported identifiers for local modules. Updated on kick
|
||||
@ -677,12 +665,7 @@ shakeOpen recorder lspEnv defaultConfig idePlugins debouncer
|
||||
restartQueue = tRestartQueue threadQueue
|
||||
loaderQueue = tLoaderQueue threadQueue
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
ideNc <- initNameCache 'r' knownKeyNames
|
||||
#else
|
||||
us <- mkSplitUniqSupply 'r'
|
||||
ideNc <- newIORef (initNameCache us knownKeyNames)
|
||||
#endif
|
||||
shakeExtras <- do
|
||||
globals <- newTVarIO HMap.empty
|
||||
state <- STM.newIO
|
||||
@ -1080,13 +1063,8 @@ askShake :: IdeAction ShakeExtras
|
||||
askShake = ask
|
||||
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
mkUpdater :: NameCache -> NameCacheUpdater
|
||||
mkUpdater = id
|
||||
#else
|
||||
mkUpdater :: IORef NameCache -> NameCacheUpdater
|
||||
mkUpdater ref = NCU (upNameCache ref)
|
||||
#endif
|
||||
|
||||
-- | A (maybe) stale result now, and an up to date one later
|
||||
data FastResult a = FastResult { stale :: Maybe (a,PositionMapping), uptoDate :: IO (Maybe a) }
|
||||
|
||||
@ -22,11 +22,8 @@ import GHC.Settings
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
import qualified GHC.Driver.Pipeline as Pipeline
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0) && !MIN_VERSION_ghc(9,5,0)
|
||||
#if !MIN_VERSION_ghc(9,5,0)
|
||||
import qualified GHC.Driver.Pipeline.Execute as Pipeline
|
||||
#endif
|
||||
|
||||
|
||||
@ -98,20 +98,9 @@ module Development.IDE.GHC.Compat(
|
||||
extract_cons,
|
||||
recDotDot,
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
Dependencies(dep_mods),
|
||||
NameCacheUpdater(NCU),
|
||||
extendModSummaryNoDeps,
|
||||
emsModSummary,
|
||||
nonDetNameEnvElts,
|
||||
nonDetOccEnvElts,
|
||||
upNameCache,
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
Dependencies(dep_direct_mods),
|
||||
NameCacheUpdater,
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,5,0)
|
||||
XModulePs(..),
|
||||
@ -196,19 +185,10 @@ import GHC.Unit.Module.ModIface
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
import Data.IORef
|
||||
import GHC.Runtime.Interpreter
|
||||
import GHC.Unit.Module.Deps (Dependencies (dep_mods),
|
||||
Usage (..))
|
||||
import GHC.Unit.Module.ModSummary
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import GHC.Driver.Config.Stg.Pipeline
|
||||
import GHC.Unit.Module.Deps (Dependencies (dep_direct_mods),
|
||||
Usage (..))
|
||||
#endif
|
||||
|
||||
#if !MIN_VERSION_ghc(9,5,0)
|
||||
import GHC.Core.Lint (lintInteractiveExpr)
|
||||
@ -234,35 +214,19 @@ nonDetFoldOccEnv :: (a -> b -> b) -> b -> OccEnv a -> b
|
||||
nonDetFoldOccEnv = foldOccEnv
|
||||
#endif
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
nonDetOccEnvElts :: OccEnv a -> [a]
|
||||
nonDetOccEnvElts = occEnvElts
|
||||
#endif
|
||||
|
||||
type ModIfaceAnnotation = Annotation
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
nonDetNameEnvElts :: NameEnv a -> [a]
|
||||
nonDetNameEnvElts = nameEnvElts
|
||||
#endif
|
||||
|
||||
myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
-> Bool
|
||||
#endif
|
||||
-> Module -> ModLocation -> CoreExpr
|
||||
-> IO ( Id
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
,[CgStgTopBinding] -- output program
|
||||
#else
|
||||
,[StgTopBinding] -- output program
|
||||
#endif
|
||||
, InfoTableProvMap
|
||||
, CollectedCCs )
|
||||
myCoreToStgExpr logger dflags ictxt
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
for_bytecode
|
||||
#endif
|
||||
this_mod ml prepd_expr = do
|
||||
{- Create a temporary binding (just because myCoreToStg needs a
|
||||
binding for the stg2stg step) -}
|
||||
@ -278,30 +242,20 @@ myCoreToStgExpr logger dflags ictxt
|
||||
myCoreToStg logger
|
||||
dflags
|
||||
ictxt
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
for_bytecode
|
||||
#endif
|
||||
this_mod
|
||||
ml
|
||||
[NonRec bco_tmp_id prepd_expr]
|
||||
return (bco_tmp_id, stg_binds, prov_map, collected_ccs)
|
||||
|
||||
myCoreToStg :: Logger -> DynFlags -> InteractiveContext
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
-> Bool
|
||||
#endif
|
||||
-> Module -> ModLocation -> CoreProgram
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
-> IO ( [CgStgTopBinding] -- output program
|
||||
#else
|
||||
-> IO ( [StgTopBinding] -- output program
|
||||
#endif
|
||||
, InfoTableProvMap
|
||||
, CollectedCCs ) -- CAF cost centre info (declared and used)
|
||||
myCoreToStg logger dflags ictxt
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
for_bytecode
|
||||
#endif
|
||||
this_mod ml prepd_binds = do
|
||||
let (stg_binds, denv, cost_centre_info)
|
||||
= {-# SCC "Core2Stg" #-}
|
||||
@ -321,7 +275,6 @@ myCoreToStg logger dflags ictxt
|
||||
stg_binds2
|
||||
#endif
|
||||
<- {-# SCC "Stg2Stg" #-}
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
stg2stg logger
|
||||
#if MIN_VERSION_ghc(9,5,0)
|
||||
(interactiveInScope ictxt)
|
||||
@ -329,9 +282,6 @@ myCoreToStg logger dflags ictxt
|
||||
ictxt
|
||||
#endif
|
||||
(initStgPipelineOpts dflags for_bytecode) this_mod stg_binds
|
||||
#else
|
||||
stg2stg logger dflags ictxt this_mod stg_binds
|
||||
#endif
|
||||
|
||||
return (stg_binds2, denv, cost_centre_info)
|
||||
|
||||
@ -342,11 +292,7 @@ reLocA = reLoc
|
||||
#endif
|
||||
|
||||
getDependentMods :: ModIface -> [ModuleName]
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
getDependentMods = map (gwib_mod . snd) . S.toList . dep_direct_mods . mi_deps
|
||||
#else
|
||||
getDependentMods = map gwib_mod . dep_mods . mi_deps
|
||||
#endif
|
||||
|
||||
simplifyExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr
|
||||
#if MIN_VERSION_ghc(9,5,0)
|
||||
@ -366,50 +312,18 @@ corePrepExpr _ = GHC.corePrepExpr
|
||||
|
||||
renderMessages :: PsMessages -> (Bag WarnMsg, Bag ErrMsg)
|
||||
renderMessages msgs =
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
let renderMsgs extractor = (fmap . fmap) renderDiagnosticMessageWithHints . getMessages $ extractor msgs
|
||||
in (renderMsgs psWarnings, renderMsgs psErrors)
|
||||
#else
|
||||
msgs
|
||||
#endif
|
||||
|
||||
pattern PFailedWithErrorMessages :: forall a b. (b -> Bag (MsgEnvelope DecoratedSDoc)) -> ParseResult a
|
||||
pattern PFailedWithErrorMessages msgs
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
<- PFailed (const . fmap (fmap renderDiagnosticMessageWithHints) . getMessages . getPsErrorMessages -> msgs)
|
||||
#else
|
||||
<- PFailed (const . fmap pprError . getErrorMessages -> msgs)
|
||||
#endif
|
||||
{-# COMPLETE POk, PFailedWithErrorMessages #-}
|
||||
|
||||
hieExportNames :: HieFile -> [(SrcSpan, Name)]
|
||||
hieExportNames = nameListFromAvails . hie_exports
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
type NameCacheUpdater = NameCache
|
||||
#else
|
||||
|
||||
lookupNameCache :: Module -> OccName -> NameCache -> (NameCache, Name)
|
||||
-- Lookup up the (Module,OccName) in the NameCache
|
||||
-- If you find it, return it; if not, allocate a fresh original name and extend
|
||||
-- the NameCache.
|
||||
-- Reason: this may the first occurrence of (say) Foo.bar we have encountered.
|
||||
-- If we need to explore its value we will load Foo.hi; but meanwhile all we
|
||||
-- need is a Name for it.
|
||||
lookupNameCache mod occ name_cache =
|
||||
case lookupOrigNameCache (nsNames name_cache) mod occ of {
|
||||
Just name -> (name_cache, name);
|
||||
Nothing ->
|
||||
case takeUniqFromSupply (nsUniqs name_cache) of {
|
||||
(uniq, us) ->
|
||||
let
|
||||
name = mkExternalName uniq mod occ noSrcSpan
|
||||
new_cache = extendNameCache (nsNames name_cache) mod occ name
|
||||
in (name_cache{ nsUniqs = us, nsNames = new_cache }, name) }}
|
||||
|
||||
upNameCache :: IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
|
||||
upNameCache = updNameCache
|
||||
#endif
|
||||
|
||||
mkHieFile' :: ModSummary
|
||||
-> [Avail.AvailInfo]
|
||||
@ -568,16 +482,7 @@ loadModulesHome
|
||||
-> HscEnv
|
||||
-> HscEnv
|
||||
loadModulesHome mod_infos e =
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
hscUpdateHUG (\hug -> foldl' (flip addHomeModInfoToHug) hug mod_infos) (e { hsc_type_env_vars = emptyKnotVars })
|
||||
#else
|
||||
let !new_modules = addListToHpt (hsc_HPT e) [(mod_name x, x) | x <- mod_infos]
|
||||
in e { hsc_HPT = new_modules
|
||||
, hsc_type_env_var = Nothing
|
||||
}
|
||||
where
|
||||
mod_name = moduleName . mi_module . hm_iface
|
||||
#endif
|
||||
|
||||
recDotDot :: HsRecFields (GhcPass p) arg -> Maybe Int
|
||||
recDotDot x =
|
||||
|
||||
@ -13,26 +13,7 @@ module Development.IDE.GHC.Compat.CmdLine (
|
||||
, liftEwM
|
||||
) where
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import GHC.Driver.CmdLine
|
||||
import GHC.Driver.Session (CmdLineP (..), getCmdLineState,
|
||||
processCmdLineP, putCmdLineState)
|
||||
#else
|
||||
import Control.Monad.IO.Class
|
||||
import GHC (Located)
|
||||
import GHC.Driver.CmdLine
|
||||
#endif
|
||||
import GHC.Driver.Session (CmdLineP (..), getCmdLineState,
|
||||
processCmdLineP, putCmdLineState)
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
-- | A helper to parse a set of flags from a list of command-line arguments, handling
|
||||
-- response files.
|
||||
processCmdLineP
|
||||
:: forall s m. MonadIO m
|
||||
=> [Flag (CmdLineP s)] -- ^ valid flags to match against
|
||||
-> s -- ^ current state
|
||||
-> [Located String] -- ^ arguments to parse
|
||||
-> m (([Located String], [Err], [Warn]), s)
|
||||
-- ^ (leftovers, errors, warnings)
|
||||
processCmdLineP activeFlags s0 args =
|
||||
pure $ runCmdLine (processArgs activeFlags args) s0
|
||||
#endif
|
||||
|
||||
@ -58,9 +58,6 @@ module Development.IDE.GHC.Compat.Core (
|
||||
pattern ExposePackage,
|
||||
parseDynamicFlagsCmdLine,
|
||||
parseDynamicFilePragma,
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
WarnReason(..),
|
||||
#endif
|
||||
wWarningFlags,
|
||||
updOptLevel,
|
||||
-- slightly unsafe
|
||||
@ -75,9 +72,6 @@ module Development.IDE.GHC.Compat.Core (
|
||||
HscSource(..),
|
||||
WhereFrom(..),
|
||||
loadInterface,
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
SourceModified(..),
|
||||
#endif
|
||||
loadModuleInterface,
|
||||
RecompileRequired(..),
|
||||
mkPartialIface,
|
||||
@ -359,7 +353,6 @@ module Development.IDE.GHC.Compat.Core (
|
||||
module GHC.Parser.Header,
|
||||
module GHC.Parser.Lexer,
|
||||
module GHC.Utils.Panic,
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
CompileReason(..),
|
||||
hsc_type_env_vars,
|
||||
hscUpdateHUG, hsc_HUG,
|
||||
@ -372,7 +365,6 @@ module Development.IDE.GHC.Compat.Core (
|
||||
module GHC.Unit.Finder.Types,
|
||||
module GHC.Unit.Env,
|
||||
module GHC.Driver.Phases,
|
||||
#endif
|
||||
#if !MIN_VERSION_ghc(9,4,0)
|
||||
pattern HsFieldBind,
|
||||
hfbAnn,
|
||||
@ -536,13 +528,7 @@ import Language.Haskell.Syntax hiding (FunDep)
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
import GHC.Types.SourceFile (SourceModified (..))
|
||||
import qualified GHC.Unit.Finder as GHC
|
||||
import GHC.Unit.Module.Graph (mkModuleGraph)
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import qualified GHC.Data.Strict as Strict
|
||||
import qualified GHC.Driver.Config.Finder as GHC
|
||||
import qualified GHC.Driver.Config.Tidy as GHC
|
||||
@ -558,39 +544,22 @@ import GHC.Unit.Module.Graph
|
||||
import GHC.Utils.Error (mkPlainErrorMsgEnvelope)
|
||||
import GHC.Utils.Panic
|
||||
import GHC.Utils.TmpFs
|
||||
#endif
|
||||
|
||||
#if !MIN_VERSION_ghc(9,7,0)
|
||||
import GHC.Types.Avail (greNamePrintableName)
|
||||
#endif
|
||||
|
||||
mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO Module.ModLocation
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
mkHomeModLocation df mn f = pure $ GHC.mkHomeModLocation (GHC.initFinderOpts df) mn f
|
||||
#else
|
||||
mkHomeModLocation = GHC.mkHomeModLocation
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
pattern RealSrcSpan :: SrcLoc.RealSrcSpan -> Maybe BufSpan -> SrcLoc.SrcSpan
|
||||
#else
|
||||
pattern RealSrcSpan :: SrcLoc.RealSrcSpan -> Maybe BufSpan -> SrcLoc.SrcSpan
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
pattern RealSrcSpan x y <- SrcLoc.RealSrcSpan x ((\case Strict.Nothing -> Nothing; Strict.Just a -> Just a) -> y) where
|
||||
RealSrcSpan x y = SrcLoc.RealSrcSpan x (case y of Nothing -> Strict.Nothing; Just a -> Strict.Just a)
|
||||
|
||||
#else
|
||||
pattern RealSrcSpan x y = SrcLoc.RealSrcSpan x y
|
||||
#endif
|
||||
{-# COMPLETE RealSrcSpan, UnhelpfulSpan #-}
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
pattern RealSrcLoc :: SrcLoc.RealSrcLoc -> Strict.Maybe BufPos-> SrcLoc.SrcLoc
|
||||
#else
|
||||
pattern RealSrcLoc :: SrcLoc.RealSrcLoc -> Maybe BufPos-> SrcLoc.SrcLoc
|
||||
#endif
|
||||
pattern RealSrcLoc x y = SrcLoc.RealSrcLoc x y
|
||||
{-# COMPLETE RealSrcLoc, UnhelpfulLoc #-}
|
||||
|
||||
@ -718,12 +687,6 @@ unload hsc_env linkables =
|
||||
(GHCi.hscInterp hsc_env)
|
||||
hsc_env linkables
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
setOutputFile :: FilePath -> DynFlags -> DynFlags
|
||||
setOutputFile f d = d {
|
||||
outputFile_ = Just f
|
||||
}
|
||||
#endif
|
||||
|
||||
isSubspanOfA :: LocatedAn la a -> LocatedAn lb b -> Bool
|
||||
isSubspanOfA a b = SrcLoc.isSubspanOf (GHC.getLocA a) (GHC.getLocA b)
|
||||
@ -752,54 +715,28 @@ collectHsBindsBinders x = GHC.collectHsBindsBinders CollNoDictBinders x
|
||||
makeSimpleDetails :: HscEnv -> TcGblEnv -> IO ModDetails
|
||||
makeSimpleDetails hsc_env =
|
||||
GHC.makeSimpleDetails
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
(hsc_logger hsc_env)
|
||||
#else
|
||||
hsc_env
|
||||
#endif
|
||||
|
||||
mkIfaceTc :: HscEnv -> GHC.SafeHaskellMode -> ModDetails -> ModSummary -> Maybe CoreProgram -> TcGblEnv -> IO ModIface
|
||||
mkIfaceTc hscEnv shm md _ms _mcp =
|
||||
#if MIN_VERSION_ghc(9,5,0)
|
||||
GHC.mkIfaceTc hscEnv shm md _ms _mcp -- mcp::Maybe CoreProgram is only used in GHC >= 9.6
|
||||
#elif MIN_VERSION_ghc(9,3,0)
|
||||
GHC.mkIfaceTc hscEnv shm md _ms -- ms::ModSummary is only used in GHC >= 9.4
|
||||
#else
|
||||
GHC.mkIfaceTc hscEnv shm md
|
||||
GHC.mkIfaceTc hscEnv shm md _ms -- ms::ModSummary is only used in GHC >= 9.4
|
||||
#endif
|
||||
|
||||
mkBootModDetailsTc :: HscEnv -> TcGblEnv -> IO ModDetails
|
||||
mkBootModDetailsTc session = GHC.mkBootModDetailsTc
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
(hsc_logger session)
|
||||
#else
|
||||
session
|
||||
#endif
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
type TidyOpts = HscEnv
|
||||
#endif
|
||||
|
||||
initTidyOpts :: HscEnv -> IO TidyOpts
|
||||
initTidyOpts =
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
GHC.initTidyOpts
|
||||
#else
|
||||
pure
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
driverNoStop :: StopPhase
|
||||
driverNoStop = NoStop
|
||||
#else
|
||||
driverNoStop :: Phase
|
||||
driverNoStop = StopLn
|
||||
#endif
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
hscUpdateHPT :: (HomePackageTable -> HomePackageTable) -> HscEnv -> HscEnv
|
||||
hscUpdateHPT k session = session { hsc_HPT = k (hsc_HPT session) }
|
||||
#endif
|
||||
|
||||
#if !MIN_VERSION_ghc(9,4,0)
|
||||
pattern HsFieldBind :: XHsRecField id -> id -> arg -> Bool -> HsRecField' id arg
|
||||
@ -846,11 +783,7 @@ field_label = id
|
||||
#endif
|
||||
|
||||
mkSimpleTarget :: DynFlags -> FilePath -> Target
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
mkSimpleTarget df fp = Target (TargetFile fp Nothing) True (homeUnitId_ df) Nothing
|
||||
#else
|
||||
mkSimpleTarget _ fp = Target (TargetFile fp Nothing) True Nothing
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,7,0)
|
||||
lookupGlobalRdrEnv gre_env occ = lookupGRE gre_env (LookupOccName occ AllRelevantGREs)
|
||||
|
||||
@ -4,11 +4,7 @@
|
||||
-- 'UnitEnv' and some DynFlags compat functions.
|
||||
module Development.IDE.GHC.Compat.Env (
|
||||
Env.HscEnv(hsc_FC, hsc_NC, hsc_IC, hsc_mod_graph
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
, hsc_type_env_vars
|
||||
#else
|
||||
, hsc_type_env_var
|
||||
#endif
|
||||
),
|
||||
Env.hsc_HPT,
|
||||
InteractiveContext(..),
|
||||
@ -19,9 +15,6 @@ module Development.IDE.GHC.Compat.Env (
|
||||
Env.hsc_logger,
|
||||
Env.hsc_tmpfs,
|
||||
Env.hsc_unit_env,
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
Env.hsc_unit_dbs,
|
||||
#endif
|
||||
Env.hsc_hooks,
|
||||
hscSetHooks,
|
||||
TmpFs,
|
||||
@ -78,39 +71,16 @@ import GHC.Utils.TmpFs
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
import qualified Data.Set as S
|
||||
import GHC.Driver.Env (HscEnv, hsc_EPS)
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import GHC.Driver.Env (HscEnv, hscSetActiveUnitId)
|
||||
#endif
|
||||
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
hscSetActiveUnitId :: UnitId -> HscEnv -> HscEnv
|
||||
hscSetActiveUnitId _ env = env
|
||||
|
||||
reexportedModules :: HscEnv -> S.Set a
|
||||
reexportedModules _ = S.empty
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
hsc_EPS :: HscEnv -> UnitEnv
|
||||
hsc_EPS = Env.hsc_unit_env
|
||||
#endif
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
workingDirectory :: a -> Maybe b
|
||||
workingDirectory _ = Nothing
|
||||
|
||||
setWorkingDirectory :: FilePath -> DynFlags -> DynFlags
|
||||
setWorkingDirectory = const id
|
||||
#else
|
||||
setWorkingDirectory :: FilePath -> DynFlags -> DynFlags
|
||||
setWorkingDirectory p d = d { workingDirectory = Just p }
|
||||
#endif
|
||||
|
||||
setHomeUnitId_ :: UnitId -> DynFlags -> DynFlags
|
||||
setHomeUnitId_ uid df = df { Session.homeUnitId_ = uid }
|
||||
|
||||
@ -14,9 +14,7 @@ import GHC.Unit.Finder.Types (FindResult)
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import GHC.Driver.Session (targetProfile)
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,7,0)
|
||||
import GHC.Iface.Errors.Ppr (missingInterfaceErrorDiagnostic)
|
||||
@ -24,11 +22,7 @@ import GHC.Iface.Errors.Types (IfaceMessage)
|
||||
#endif
|
||||
|
||||
writeIfaceFile :: HscEnv -> FilePath -> ModIface -> IO ()
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
writeIfaceFile env fp iface = Iface.writeIface (hsc_logger env) (targetProfile $ hsc_dflags env) fp iface
|
||||
#else
|
||||
writeIfaceFile env fp iface = Iface.writeIface (hsc_logger env) (hsc_dflags env) fp iface
|
||||
#endif
|
||||
|
||||
cannotFindModule :: HscEnv -> ModuleName -> FindResult -> SDoc
|
||||
cannotFindModule env modname fr =
|
||||
|
||||
@ -19,15 +19,12 @@ import GHC.Utils.Outputable
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import GHC.Types.Error
|
||||
#endif
|
||||
|
||||
putLogHook :: Logger -> HscEnv -> HscEnv
|
||||
putLogHook logger env =
|
||||
env { hsc_logger = logger }
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
type LogActionCompat = LogFlags -> Maybe DiagnosticReason -> Maybe Severity -> SrcSpan -> PrintUnqualified -> SDoc -> IO ()
|
||||
|
||||
-- alwaysQualify seems to still do the right thing here, according to the "unqualified warnings" test.
|
||||
@ -41,11 +38,3 @@ logActionCompat logAction logFlags (MCDiagnostic severity wr) loc = logAction lo
|
||||
#endif
|
||||
logActionCompat logAction logFlags _cls loc = logAction logFlags Nothing Nothing loc alwaysQualify
|
||||
|
||||
#else
|
||||
type LogActionCompat = DynFlags -> WarnReason -> Severity -> SrcSpan -> PrintUnqualified -> SDoc -> IO ()
|
||||
|
||||
-- alwaysQualify seems to still do the right thing here, according to the "unqualified warnings" test.
|
||||
logActionCompat :: LogActionCompat -> LogAction
|
||||
logActionCompat logAction dynFlags wr severity loc = logAction dynFlags wr severity loc alwaysQualify
|
||||
|
||||
#endif
|
||||
|
||||
@ -24,7 +24,6 @@ module Development.IDE.GHC.Compat.Outputable (
|
||||
initDiagOpts,
|
||||
pprMessages,
|
||||
#endif
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
DiagnosticReason(..),
|
||||
renderDiagnosticMessageWithHints,
|
||||
pprMsgEnvelopeBagWithLoc,
|
||||
@ -34,10 +33,6 @@ module Development.IDE.GHC.Compat.Outputable (
|
||||
errMsgDiagnostic,
|
||||
unDecorated,
|
||||
diagnosticMessage,
|
||||
#else
|
||||
pprWarning,
|
||||
pprError,
|
||||
#endif
|
||||
-- * Error infrastructure
|
||||
DecoratedSDoc,
|
||||
MsgEnvelope,
|
||||
@ -67,18 +62,11 @@ import GHC.Utils.Panic
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
import GHC.Parser.Errors
|
||||
import qualified GHC.Parser.Errors.Ppr as Ppr
|
||||
import GHC.Utils.Error hiding (mkWarnMsg)
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import Data.Maybe
|
||||
import GHC.Driver.Config.Diagnostic
|
||||
import GHC.Parser.Errors.Types
|
||||
import GHC.Utils.Error
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,5,0)
|
||||
import GHC.Driver.Errors.Types (DriverMessage, GhcMessage)
|
||||
@ -114,43 +102,26 @@ printSDocQualifiedUnsafe unqual doc =
|
||||
doc' = pprWithUnitState emptyUnitState doc
|
||||
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
pprWarning :: PsWarning -> MsgEnvelope DecoratedSDoc
|
||||
pprWarning =
|
||||
Ppr.pprWarning
|
||||
|
||||
pprError :: PsError -> MsgEnvelope DecoratedSDoc
|
||||
pprError =
|
||||
Ppr.pprError
|
||||
#endif
|
||||
|
||||
formatErrorWithQual :: DynFlags -> MsgEnvelope DecoratedSDoc -> String
|
||||
formatErrorWithQual dflags e =
|
||||
showSDoc dflags (pprNoLocMsgEnvelope e)
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
pprNoLocMsgEnvelope :: MsgEnvelope DecoratedSDoc -> SDoc
|
||||
#else
|
||||
pprNoLocMsgEnvelope :: Error.RenderableDiagnostic e => MsgEnvelope e -> SDoc
|
||||
#endif
|
||||
pprNoLocMsgEnvelope (MsgEnvelope { errMsgDiagnostic = e
|
||||
, errMsgContext = unqual })
|
||||
= sdocWithContext $ \_ctx ->
|
||||
withErrStyle unqual $
|
||||
#if MIN_VERSION_ghc(9,7,0)
|
||||
formatBulleted e
|
||||
#elif MIN_VERSION_ghc(9,3,0)
|
||||
formatBulleted _ctx $ e
|
||||
#else
|
||||
formatBulleted _ctx $ Error.renderDiagnostic e
|
||||
formatBulleted _ctx $ e
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
type ErrMsg = MsgEnvelope DecoratedSDoc
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
type WarnMsg = MsgEnvelope DecoratedSDoc
|
||||
#endif
|
||||
|
||||
mkPrintUnqualifiedDefault :: HscEnv -> GlobalRdrEnv -> PrintUnqualified
|
||||
#if MIN_VERSION_ghc(9,5,0)
|
||||
@ -165,7 +136,6 @@ mkPrintUnqualifiedDefault env =
|
||||
mkPrintUnqualified (hsc_unit_env env)
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
renderDiagnosticMessageWithHints :: forall a. Diagnostic a => a -> DecoratedSDoc
|
||||
renderDiagnosticMessageWithHints a = Error.unionDecoratedSDoc
|
||||
(diagnosticMessage
|
||||
@ -173,16 +143,9 @@ renderDiagnosticMessageWithHints a = Error.unionDecoratedSDoc
|
||||
(defaultDiagnosticOpts @a)
|
||||
#endif
|
||||
a) (mkDecorated $ map ppr $ diagnosticHints a)
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
mkWarnMsg :: DynFlags -> Maybe DiagnosticReason -> b -> SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc
|
||||
mkWarnMsg df reason _logFlags l st doc = fmap renderDiagnosticMessageWithHints $ mkMsgEnvelope (initDiagOpts df) l st (mkPlainDiagnostic (fromMaybe WarningWithoutFlag reason) [] doc)
|
||||
#else
|
||||
mkWarnMsg :: a -> b -> DynFlags -> SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc
|
||||
mkWarnMsg _ _ =
|
||||
const Error.mkWarnMsg
|
||||
#endif
|
||||
|
||||
textDoc :: String -> SDoc
|
||||
textDoc = text
|
||||
|
||||
@ -42,13 +42,8 @@ import GHC.Hs (hpm_module, hpm_src_files)
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
import qualified GHC.Driver.Config as Config
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import qualified GHC.Driver.Config.Parser as Config
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
|
||||
@ -33,51 +33,25 @@ import qualified GHC.Runtime.Loader as Loader
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
import Data.Bifunctor (bimap)
|
||||
import Development.IDE.GHC.Compat.Outputable as Out
|
||||
import Development.IDE.GHC.Compat.Util (Bag)
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import GHC.Driver.Plugins (ParsedResult (..),
|
||||
PsMessages (..),
|
||||
staticPlugins)
|
||||
import qualified GHC.Parser.Lexer as Lexer
|
||||
#endif
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
type PsMessages = (Bag WarnMsg, Bag ErrMsg)
|
||||
#endif
|
||||
|
||||
getPsMessages :: PState -> PsMessages
|
||||
getPsMessages pst =
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
uncurry PsMessages $ Lexer.getPsMessages pst
|
||||
#else
|
||||
bimap (fmap pprWarning) (fmap pprError) $ getMessages pst
|
||||
#endif
|
||||
|
||||
applyPluginsParsedResultAction :: HscEnv -> ModSummary -> Parser.ApiAnns -> ParsedSource -> PsMessages -> IO (ParsedSource, PsMessages)
|
||||
applyPluginsParsedResultAction env ms hpm_annotations parsed msgs = do
|
||||
-- Apply parsedResultAction of plugins
|
||||
let applyPluginAction p opts = parsedResultAction p opts ms
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
fmap (\result -> (hpm_module (parsedResultModule result), (parsedResultMessages result))) $ runHsc env $ withPlugins
|
||||
#else
|
||||
fmap (\parsed_module -> (hpm_module parsed_module, msgs)) $ runHsc env $ withPlugins
|
||||
#endif
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
(Env.hsc_plugins env)
|
||||
#else
|
||||
env
|
||||
#endif
|
||||
applyPluginAction
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
(ParsedResult (HsParsedModule parsed [] hpm_annotations) msgs)
|
||||
#else
|
||||
(HsParsedModule parsed [] hpm_annotations)
|
||||
#endif
|
||||
|
||||
initializePlugins :: HscEnv -> IO HscEnv
|
||||
initializePlugins env = do
|
||||
@ -91,8 +65,4 @@ initPlugins session modSummary = do
|
||||
return (modSummary{ms_hspp_opts = hsc_dflags session1}, session1)
|
||||
|
||||
hsc_static_plugins :: HscEnv -> [StaticPlugin]
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
hsc_static_plugins = staticPlugins . Env.hsc_plugins
|
||||
#else
|
||||
hsc_static_plugins = Env.hsc_static_plugins
|
||||
#endif
|
||||
|
||||
@ -71,15 +71,7 @@ import GHC.Unit.Types
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
import GHC.Data.FastString
|
||||
import GHC.Unit.Env
|
||||
import GHC.Unit.Finder hiding
|
||||
(findImportedModule)
|
||||
import qualified GHC.Unit.Types as Unit
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import Control.Monad
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Map.Strict as Map
|
||||
@ -87,7 +79,6 @@ import qualified GHC
|
||||
import qualified GHC.Driver.Session as DynFlags
|
||||
import GHC.Types.PkgQual (PkgQual (NoPkgQual))
|
||||
import GHC.Unit.Home.ModInfo
|
||||
#endif
|
||||
|
||||
|
||||
type PreloadUnitClosure = UniqSet UnitId
|
||||
@ -95,7 +86,6 @@ type PreloadUnitClosure = UniqSet UnitId
|
||||
unitState :: HscEnv -> UnitState
|
||||
unitState = ue_units . hsc_unit_env
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
createUnitEnvFromFlags :: NE.NonEmpty DynFlags -> HomeUnitGraph
|
||||
createUnitEnvFromFlags unitDflags =
|
||||
let
|
||||
@ -135,10 +125,6 @@ initUnits unitDflags env = do
|
||||
, ue_eps = ue_eps (hsc_unit_env env)
|
||||
}
|
||||
pure $ hscSetFlags dflags1 $ hscSetUnitEnv unit_env env
|
||||
#else
|
||||
initUnits :: [DynFlags] -> HscEnv -> IO HscEnv
|
||||
initUnits _df env = pure env -- Can't do anything here, oldInitUnits should already be called
|
||||
#endif
|
||||
|
||||
|
||||
-- | oldInitUnits only needs to modify DynFlags for GHC <9.2
|
||||
@ -149,11 +135,7 @@ oldInitUnits = pure
|
||||
|
||||
explicitUnits :: UnitState -> [Unit]
|
||||
explicitUnits ue =
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
map fst $ State.explicitUnits ue
|
||||
#else
|
||||
State.explicitUnits ue
|
||||
#endif
|
||||
|
||||
listVisibleModuleNames :: HscEnv -> [ModuleName]
|
||||
listVisibleModuleNames env =
|
||||
@ -166,11 +148,7 @@ getUnitName env i =
|
||||
lookupModuleWithSuggestions
|
||||
:: HscEnv
|
||||
-> ModuleName
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
-> GHC.PkgQual
|
||||
#else
|
||||
-> Maybe FastString
|
||||
#endif
|
||||
-> LookupResult
|
||||
lookupModuleWithSuggestions env modname mpkg =
|
||||
State.lookupModuleWithSuggestions (unitState env) modname mpkg
|
||||
@ -204,10 +182,6 @@ defUnitId = Definite
|
||||
installedModule :: unit -> ModuleName -> GenModule unit
|
||||
installedModule = Module
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
moduleUnitId :: Module -> UnitId
|
||||
moduleUnitId = Unit.toUnitId . Unit.moduleUnit
|
||||
#endif
|
||||
|
||||
filterInplaceUnits :: [UnitId] -> [PackageFlag] -> ([UnitId], [PackageFlag])
|
||||
filterInplaceUnits us packageFlags =
|
||||
@ -225,11 +199,7 @@ showSDocForUser' env = showSDocForUser (hsc_dflags env) (unitState env)
|
||||
|
||||
findImportedModule :: HscEnv -> ModuleName -> IO (Maybe Module)
|
||||
findImportedModule env mn = do
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
res <- GHC.findImportedModule env mn NoPkgQual
|
||||
#else
|
||||
res <- GHC.findImportedModule env mn Nothing
|
||||
#endif
|
||||
case res of
|
||||
Found _ mod -> pure . pure $ mod
|
||||
_ -> pure Nothing
|
||||
|
||||
@ -82,10 +82,5 @@ import GHC.Utils.Panic hiding (try)
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
import GHC.Utils.Misc
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import GHC.Data.Bool
|
||||
#endif
|
||||
|
||||
@ -157,17 +157,9 @@ spanContainsRange srcSpan range = (range `isSubrangeOf`) <$> srcSpanToRange srcS
|
||||
-- | Convert a GHC severity to a DAML compiler Severity. Severities below
|
||||
-- "Warning" level are dropped (returning Nothing).
|
||||
toDSeverity :: GHC.Severity -> Maybe D.DiagnosticSeverity
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
toDSeverity SevOutput = Nothing
|
||||
toDSeverity SevInteractive = Nothing
|
||||
toDSeverity SevDump = Nothing
|
||||
toDSeverity SevInfo = Just DiagnosticSeverity_Information
|
||||
toDSeverity SevFatal = Just DiagnosticSeverity_Error
|
||||
#else
|
||||
toDSeverity SevIgnore = Nothing
|
||||
#endif
|
||||
toDSeverity SevWarning = Just DiagnosticSeverity_Warning
|
||||
toDSeverity SevError = Just DiagnosticSeverity_Error
|
||||
toDSeverity SevIgnore = Nothing
|
||||
toDSeverity SevWarning = Just DiagnosticSeverity_Warning
|
||||
toDSeverity SevError = Just DiagnosticSeverity_Error
|
||||
|
||||
|
||||
-- | Produce a bag of GHC-style errors (@ErrorMessages@) from the given
|
||||
@ -208,9 +200,7 @@ catchSrcErrors dflags fromWhere ghcM = do
|
||||
where
|
||||
ghcExceptionToDiagnostics = return . Left . diagFromGhcException fromWhere dflags
|
||||
sourceErrorToDiagnostics = return . Left . diagFromErrMsgs fromWhere dflags
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
. fmap (fmap Compat.renderDiagnosticMessageWithHints) . Compat.getMessages
|
||||
#endif
|
||||
. srcErrorMessages
|
||||
|
||||
|
||||
|
||||
@ -25,18 +25,12 @@ import GHC.Types.SrcLoc
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
import GHC.Types.Unique (getKey)
|
||||
import GHC.Unit.Module.Graph (ModuleGraph)
|
||||
#endif
|
||||
|
||||
import Data.Bifunctor (Bifunctor (..))
|
||||
import GHC.Parser.Annotation
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import GHC.Types.PkgQual
|
||||
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,5,0)
|
||||
import GHC.Unit.Home.ModInfo
|
||||
@ -88,9 +82,6 @@ instance NFData SB.StringBuffer where rnf = rwhnf
|
||||
instance Show Module where
|
||||
show = moduleNameString . moduleName
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
instance Outputable a => Show (GenLocated SrcSpan a) where show = unpack . printOutputable
|
||||
#endif
|
||||
|
||||
#if !MIN_VERSION_ghc(9,5,0)
|
||||
instance (NFData l, NFData e) => NFData (GenLocated l e) where
|
||||
@ -131,12 +122,6 @@ instance Show HieFile where
|
||||
instance NFData HieFile where
|
||||
rnf = rwhnf
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
deriving instance Eq SourceModified
|
||||
deriving instance Show SourceModified
|
||||
instance NFData SourceModified where
|
||||
rnf = rwhnf
|
||||
#endif
|
||||
|
||||
instance Hashable ModuleName where
|
||||
hashWithSalt salt = hashWithSalt salt . show
|
||||
@ -222,7 +207,6 @@ instance NFData ModuleGraph where rnf = rwhnf
|
||||
instance NFData HomeModInfo where
|
||||
rnf (HomeModInfo iface dets link) = rwhnf iface `seq` rnf dets `seq` rnf link
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
instance NFData PkgQual where
|
||||
rnf NoPkgQual = ()
|
||||
rnf (ThisPkg uid) = rnf uid
|
||||
@ -233,7 +217,6 @@ instance NFData UnitId where
|
||||
|
||||
instance NFData NodeKey where
|
||||
rnf = rwhnf
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,5,0)
|
||||
instance NFData HomeModLinkable where
|
||||
|
||||
@ -24,11 +24,7 @@ import Language.LSP.Protocol.Types (type (|?) (..))
|
||||
-- https://github.com/ghc/ghc/blob/5f1d949ab9e09b8d95319633854b7959df06eb58/compiler/main/GHC.hs#L623-L640
|
||||
-- which basically says that log_action is taken from the ModSummary when GHC feels like it.
|
||||
-- The given argument lets you refresh a ModSummary log_action
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
withWarnings :: T.Text -> ((HscEnv -> HscEnv) -> IO a) -> IO ([(Maybe DiagnosticReason, FileDiagnostic)], a)
|
||||
#else
|
||||
withWarnings :: T.Text -> ((HscEnv -> HscEnv) -> IO a) -> IO ([(WarnReason, FileDiagnostic)], a)
|
||||
#endif
|
||||
withWarnings diagSource action = do
|
||||
warnings <- newVar []
|
||||
let newAction :: DynFlags -> LogActionCompat
|
||||
@ -43,7 +39,6 @@ withWarnings diagSource action = do
|
||||
third3 :: (c -> d) -> (a, b, c) -> (a, b, d)
|
||||
third3 f (a, b, c) = (a, b, f c)
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
attachReason :: Maybe DiagnosticReason -> Diagnostic -> Diagnostic
|
||||
attachReason Nothing d = d
|
||||
attachReason (Just wr) d = d{_code = InR <$> showReason wr}
|
||||
@ -51,15 +46,6 @@ attachReason (Just wr) d = d{_code = InR <$> showReason wr}
|
||||
showReason = \case
|
||||
WarningWithFlag flag -> showFlag flag
|
||||
_ -> Nothing
|
||||
#else
|
||||
attachReason :: WarnReason -> Diagnostic -> Diagnostic
|
||||
attachReason wr d = d{_code = InR <$> showReason wr}
|
||||
where
|
||||
showReason = \case
|
||||
NoReason -> Nothing
|
||||
Reason flag -> showFlag flag
|
||||
ErrReason flag -> showFlag =<< flag
|
||||
#endif
|
||||
|
||||
showFlag :: WarningFlag -> Maybe T.Text
|
||||
showFlag flag = ("-W" <>) . T.pack . flagSpecName <$> find ((== flag) . flagSpecFlag) wWarningFlags
|
||||
|
||||
@ -59,9 +59,6 @@ import Development.IDE.GHC.Compat
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
import GHC.Unit.Module.Graph (ModuleGraph)
|
||||
#endif
|
||||
|
||||
-- | The imports for a given module.
|
||||
newtype ModuleImports = ModuleImports
|
||||
|
||||
@ -30,14 +30,9 @@ import System.FilePath
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
import Development.IDE.GHC.Compat.Util
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import GHC.Types.PkgQual
|
||||
import GHC.Unit.State
|
||||
#endif
|
||||
|
||||
data Import
|
||||
= FileImport !ArtifactsLocation
|
||||
@ -105,13 +100,8 @@ locateModuleFile import_dirss exts targetFor isSource modName = do
|
||||
-- It only returns Just for unit-ids which are possible to import into the
|
||||
-- current module. In particular, it will return Nothing for 'main' components
|
||||
-- as they can never be imported into another package.
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
mkImportDirs :: HscEnv -> (UnitId, DynFlags) -> Maybe (UnitId, ([FilePath], S.Set ModuleName))
|
||||
mkImportDirs _env (i, flags) = Just (i, (importPaths flags, reexportedModules flags))
|
||||
#else
|
||||
mkImportDirs :: HscEnv -> (UnitId, DynFlags) -> Maybe (PackageName, (UnitId, [FilePath], S.Set ModuleName))
|
||||
mkImportDirs env (i, flags) = (, (i, importPaths flags, S.empty)) <$> getUnitName env i
|
||||
#endif
|
||||
|
||||
-- | locate a module in either the file system or the package database. Where we go from *daml to
|
||||
-- Haskell
|
||||
@ -122,42 +112,22 @@ locateModule
|
||||
-> [String] -- ^ File extensions
|
||||
-> (ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath)) -- ^ does file exist predicate
|
||||
-> Located ModuleName -- ^ Module name
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
-> PkgQual -- ^ Package name
|
||||
#else
|
||||
-> Maybe FastString -- ^ Package name
|
||||
#endif
|
||||
-> Bool -- ^ Is boot module
|
||||
-> m (Either [FileDiagnostic] Import)
|
||||
locateModule env comp_info exts targetFor modName mbPkgName isSource = do
|
||||
case mbPkgName of
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
-- 'ThisPkg' just means some home module, not the current unit
|
||||
ThisPkg uid
|
||||
| Just (dirs, reexports) <- lookup uid import_paths
|
||||
-> lookupLocal uid dirs reexports
|
||||
| otherwise -> return $ Left $ notFoundErr env modName $ LookupNotFound []
|
||||
#else
|
||||
-- "this" means that we should only look in the current package
|
||||
Just "this" -> do
|
||||
lookupLocal (homeUnitId_ dflags) (importPaths dflags) S.empty
|
||||
#endif
|
||||
-- if a package name is given we only go look for a package
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
OtherPkg uid
|
||||
| Just (dirs, reexports) <- lookup uid import_paths
|
||||
-> lookupLocal uid dirs reexports
|
||||
#else
|
||||
Just pkgName
|
||||
| Just (uid, dirs, reexports) <- lookup (PackageName pkgName) import_paths
|
||||
-> lookupLocal uid dirs reexports
|
||||
#endif
|
||||
| otherwise -> lookupInPackageDB
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
NoPkgQual -> do
|
||||
#else
|
||||
Nothing -> do
|
||||
#endif
|
||||
|
||||
-- Reexports for current unit have to be empty because they only apply to other units depending on the
|
||||
-- current unit. If we set the reexports to be the actual reexports then we risk looping forever trying
|
||||
@ -196,11 +166,7 @@ locateModule env comp_info exts targetFor modName mbPkgName isSource = do
|
||||
-- This is particularly important for Paths_* modules which get generated for every component but unless you use it in
|
||||
-- each component will end up being found in the wrong place and cause a multi-cradle match failure.
|
||||
_import_paths' = -- import_paths' is only used in GHC < 9.4
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import_paths
|
||||
#else
|
||||
map snd import_paths
|
||||
#endif
|
||||
|
||||
toModLocation uid file = liftIO $ do
|
||||
loc <- mkHomeModLocation dflags (unLoc modName) (fromNormalizedFilePath file)
|
||||
@ -263,10 +229,5 @@ notFound = NotFound
|
||||
, fr_suggestions = []
|
||||
}
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
noPkgQual :: PkgQual
|
||||
noPkgQual = NoPkgQual
|
||||
#else
|
||||
noPkgQual :: Maybe a
|
||||
noPkgQual = Nothing
|
||||
#endif
|
||||
|
||||
@ -31,9 +31,6 @@ import Language.LSP.Protocol.Message
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
import qualified Data.Text as T
|
||||
#endif
|
||||
|
||||
moduleOutline
|
||||
:: PluginMethodHandler IdeState Method_TextDocumentDocumentSymbol
|
||||
@ -123,16 +120,8 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam
|
||||
}
|
||||
where
|
||||
cvtFld :: LFieldOcc GhcPs -> Maybe DocumentSymbol
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
cvtFld (L (locA -> RealSrcSpan l' _) n) = Just $ (defDocumentSymbol l' :: DocumentSymbol)
|
||||
#else
|
||||
cvtFld (L (RealSrcSpan l' _) n) = Just $ (defDocumentSymbol l' :: DocumentSymbol)
|
||||
#endif
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
{ _name = printOutputable (unLoc (foLabel n))
|
||||
#else
|
||||
{ _name = printOutputable (unLoc (rdrNameFieldOcc n))
|
||||
#endif
|
||||
, _kind = SymbolKind_Field
|
||||
}
|
||||
cvtFld _ = Nothing
|
||||
@ -148,23 +137,13 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (InstD _ ClsInstD { cid_ins
|
||||
documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (InstD _ DataFamInstD { dfid_inst = DataFamInstDecl FamEqn { feqn_tycon, feqn_pats } }))
|
||||
= Just (defDocumentSymbol l :: DocumentSymbol)
|
||||
{ _name =
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
printOutputable $ pprHsArgsApp (unLoc feqn_tycon) Prefix (feqn_pats)
|
||||
#else
|
||||
printOutputable (unLoc feqn_tycon) <> " " <> T.unwords
|
||||
(map printOutputable feqn_pats)
|
||||
#endif
|
||||
, _kind = SymbolKind_Interface
|
||||
}
|
||||
documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (InstD _ TyFamInstD { tfid_inst = TyFamInstDecl _ FamEqn { feqn_tycon, feqn_pats } }))
|
||||
= Just (defDocumentSymbol l :: DocumentSymbol)
|
||||
{ _name =
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
printOutputable $ pprHsArgsApp (unLoc feqn_tycon) Prefix (feqn_pats)
|
||||
#else
|
||||
printOutputable (unLoc feqn_tycon) <> " " <> T.unwords
|
||||
(map printOutputable feqn_pats)
|
||||
#endif
|
||||
, _kind = SymbolKind_Interface
|
||||
}
|
||||
documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (DerivD _ DerivDecl { deriv_type })) =
|
||||
@ -273,10 +252,8 @@ hsConDeclsBinders cons
|
||||
-> [LFieldOcc GhcPs]
|
||||
#if MIN_VERSION_ghc(9,9,0)
|
||||
get_flds_gadt (RecConGADT _ flds) = get_flds (reLoc flds)
|
||||
#elif MIN_VERSION_ghc(9,3,0)
|
||||
get_flds_gadt (RecConGADT flds _) = get_flds (reLoc flds)
|
||||
#else
|
||||
get_flds_gadt (RecConGADT flds) = get_flds (reLoc flds)
|
||||
get_flds_gadt (RecConGADT flds _) = get_flds (reLoc flds)
|
||||
#endif
|
||||
get_flds_gadt _ = []
|
||||
|
||||
|
||||
@ -133,11 +133,7 @@ resolveCompletion ide _pid comp@CompletionItem{_detail,_documentation,_data_} ur
|
||||
$ runIdeActionE "CompletionResolve.GhcSessionDeps" (shakeExtras ide)
|
||||
$ useWithStaleFastE GhcSessionDeps file
|
||||
let nc = ideNc $ shakeExtras ide
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
name <- liftIO $ lookupNameCache nc mod occ
|
||||
#else
|
||||
name <- liftIO $ upNameCache nc (lookupNameCache mod occ)
|
||||
#endif
|
||||
mdkm <- liftIO $ runIdeAction "CompletionResolve.GetDocMap" (shakeExtras ide) $ useWithStaleFast GetDocMap file
|
||||
let (dm,km) = case mdkm of
|
||||
Just (DKMap docMap tyThingMap, _) -> (docMap,tyThingMap)
|
||||
|
||||
@ -74,10 +74,6 @@ import GHC.Plugins (Depth (AllTheWay),
|
||||
|
||||
-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
|
||||
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
import GHC.Plugins (defaultSDocContext,
|
||||
renderWithContext)
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,5,0)
|
||||
import Language.Haskell.Syntax.Basic
|
||||
@ -514,13 +510,8 @@ findRecordCompl uri mn DataDecl {tcdLName, tcdDataDefn} = result
|
||||
--
|
||||
-- is encoded as @[[arg1, arg2], [arg3], [arg4]]@
|
||||
-- Hence, we must concat nested arguments into one to get all the fields.
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
extract ConDeclField{..}
|
||||
= map (foLabel . unLoc) cd_fld_names
|
||||
#else
|
||||
extract ConDeclField{..}
|
||||
= map (rdrNameFieldOcc . unLoc) cd_fld_names
|
||||
#endif
|
||||
-- XConDeclField
|
||||
extract _ = []
|
||||
findRecordCompl _ _ _ = []
|
||||
|
||||
@ -54,13 +54,8 @@ safeTyThingId (AConLike (RealDataCon dataCon)) = Just (dataConWrapId dataCon)
|
||||
safeTyThingId _ = Nothing
|
||||
|
||||
-- Possible documentation for an element in the code
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
data SpanDoc
|
||||
= SpanDocString [HsDocString] SpanDocUris
|
||||
#else
|
||||
data SpanDoc
|
||||
= SpanDocString HsDocString SpanDocUris
|
||||
#endif
|
||||
| SpanDocText [T.Text] SpanDocUris
|
||||
deriving stock (Eq, Show, Generic)
|
||||
deriving anyclass NFData
|
||||
@ -97,11 +92,7 @@ spanDocToMarkdown :: SpanDoc -> [T.Text]
|
||||
spanDocToMarkdown = \case
|
||||
(SpanDocString docs uris) ->
|
||||
let doc = T.pack $ haddockToMarkdown $ H.toRegular $ H._doc $ H.parseParas Nothing $
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
renderHsDocStrings docs
|
||||
#else
|
||||
unpackHDS docs
|
||||
#endif
|
||||
in go [doc] uris
|
||||
(SpanDocText txt uris) -> go txt uris
|
||||
where
|
||||
|
||||
@ -41,16 +41,8 @@ mkDocMap
|
||||
-> IO DocAndTyThingMap
|
||||
mkDocMap env rm this_mod =
|
||||
do
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
(Just Docs{docs_decls = UniqMap this_docs}) <- extractDocs (hsc_dflags env) this_mod
|
||||
#else
|
||||
(_ , DeclDocMap this_docs, _) <- extractDocs this_mod
|
||||
#endif
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
d <- foldrM getDocs (fmap (\(_, x) -> (map hsDocString x) `SpanDocString` SpanDocUris Nothing Nothing) this_docs) names
|
||||
#else
|
||||
d <- foldrM getDocs (mkNameEnv $ M.toList $ fmap (`SpanDocString` SpanDocUris Nothing Nothing) this_docs) names
|
||||
#endif
|
||||
k <- foldrM getType (tcg_type_env this_mod) names
|
||||
pure $ DKMap d k
|
||||
where
|
||||
@ -84,11 +76,7 @@ getDocumentationsTryGhc env names = do
|
||||
Left _ -> return []
|
||||
Right res -> zipWithM unwrap res names
|
||||
where
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
unwrap (Right (Just docs, _)) n = SpanDocString (map hsDocString docs) <$> getUris n
|
||||
#else
|
||||
unwrap (Right (Just docs, _)) n = SpanDocString docs <$> getUris n
|
||||
#endif
|
||||
unwrap _ n = mkSpanDocText n
|
||||
|
||||
mkSpanDocText name =
|
||||
|
||||
@ -25,12 +25,10 @@ import Development.IDE.GHC.Util (printOutputable)
|
||||
import GHC.LanguageExtensions.Type (Extension (..))
|
||||
import Ide.Plugin.Eval.Util (gStrictTry)
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import GHC (setTopSessionDynFlags,
|
||||
setUnitDynFlags)
|
||||
import GHC.Driver.Env
|
||||
import GHC.Driver.Session (getDynFlags)
|
||||
#endif
|
||||
|
||||
{- $setup
|
||||
>>> import GHC
|
||||
@ -174,13 +172,9 @@ vList = vcat . map text
|
||||
|
||||
setSessionAndInteractiveDynFlags :: DynFlags -> Ghc ()
|
||||
setSessionAndInteractiveDynFlags df = do
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
_ <- setUnitDynFlags (homeUnitId_ df) df
|
||||
modifySession (hscUpdateLoggerFlags . hscSetActiveUnitId (homeUnitId_ df))
|
||||
df' <- getDynFlags
|
||||
setTopSessionDynFlags df'
|
||||
#else
|
||||
_ <- setSessionDynFlags df
|
||||
#endif
|
||||
sessDyns <- getSessionDynFlags
|
||||
setInteractiveDynFlags sessDyns
|
||||
|
||||
@ -77,7 +77,6 @@ gevaluate = liftIO . evaluate
|
||||
|
||||
showErr :: Monad m => SomeException -> m String
|
||||
showErr e =
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
case fromException e of
|
||||
-- On GHC 9.4+, the show instance adds the error message span
|
||||
-- We don't want this for the plugin
|
||||
@ -93,7 +92,6 @@ showErr e =
|
||||
. errMsgDiagnostic)
|
||||
$ getMessages msgs
|
||||
_ ->
|
||||
#endif
|
||||
return . show $ e
|
||||
|
||||
#if MIN_VERSION_ghc(9,8,0)
|
||||
|
||||
@ -133,10 +133,8 @@ h98ToGADTConDecl dataName tyVars ctxt = \case
|
||||
#endif
|
||||
#if MIN_VERSION_ghc(9,9,0)
|
||||
renderDetails (RecCon recs) = RecConGADT NoEpUniTok recs
|
||||
#elif MIN_VERSION_ghc(9,3,0)
|
||||
renderDetails (RecCon recs) = RecConGADT recs noHsUniTok
|
||||
#else
|
||||
renderDetails (RecCon recs) = RecConGADT recs
|
||||
renderDetails (RecCon recs) = RecConGADT recs noHsUniTok
|
||||
#endif
|
||||
|
||||
|
||||
@ -206,11 +204,7 @@ prettyGADTDecl df decl =
|
||||
adjustTyClD = \case
|
||||
Right (L _ (TyClD _ tycld)) -> Right $ adjustDataDecl tycld
|
||||
Right x -> Left $ "Expect TyClD but got " <> showAst x
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
Left err -> Left $ printWithoutUniques err
|
||||
#else
|
||||
Left err -> Left $ show err
|
||||
#endif
|
||||
|
||||
adjustDataDecl DataDecl{..} = DataDecl
|
||||
{ tcdDExt = adjustWhere tcdDExt
|
||||
|
||||
@ -32,9 +32,6 @@ showAstDataHtml a0 = html $
|
||||
li = tag "li"
|
||||
caret x = tag' [("class", text "caret")] "span" "" <+> x
|
||||
nested foo cts
|
||||
#if !MIN_VERSION_ghc(9,3,0)
|
||||
| cts == empty = foo
|
||||
#endif
|
||||
| otherwise = foo $$ (caret $ ul cts)
|
||||
body cts = tag "body" $ cts $$ tag "script" (text js)
|
||||
header = tag "head" $ tag "style" $ text css
|
||||
|
||||
@ -312,11 +312,7 @@ findSigOfBind range bind =
|
||||
msum
|
||||
[findSigOfBinds range (grhssLocalBinds grhs) -- where clause
|
||||
, do
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
grhs <- findDeclContainingLoc (_start range) (grhssGRHSs grhs)
|
||||
#else
|
||||
grhs <- findDeclContainingLoc (_start range) (map reLocA $ grhssGRHSs grhs)
|
||||
#endif
|
||||
case unLoc grhs of
|
||||
GRHS _ _ bd -> findSigOfExpr (unLoc bd)
|
||||
]
|
||||
@ -324,7 +320,7 @@ findSigOfBind range bind =
|
||||
findSigOfExpr :: HsExpr p -> Maybe (Sig p)
|
||||
findSigOfExpr = go
|
||||
where
|
||||
#if MIN_VERSION_ghc(9,3,0) && !MIN_VERSION_ghc(9,9,0)
|
||||
#if !MIN_VERSION_ghc(9,9,0)
|
||||
go (HsLet _ _ binds _ _) = findSigOfBinds range binds
|
||||
#else
|
||||
go (HsLet _ binds _) = findSigOfBinds range binds
|
||||
|
||||
@ -127,9 +127,7 @@ import Retrie.SYB (everything, extQ,
|
||||
import Retrie.Types
|
||||
import Retrie.Universe (Universe)
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
import GHC.Types.PkgQual
|
||||
#endif
|
||||
|
||||
data Log
|
||||
= LogParsingModule FilePath
|
||||
@ -735,11 +733,7 @@ toImportDecl AddImport {..} = GHC.ImportDecl {ideclSource = ideclSource', ..}
|
||||
ideclAs = toMod <$> ideclAsString
|
||||
ideclQualified = if ideclQualifiedBool then GHC.QualifiedPre else GHC.NotQualified
|
||||
|
||||
#if MIN_VERSION_ghc(9,3,0)
|
||||
ideclPkgQual = NoRawPkgQual
|
||||
#else
|
||||
ideclPkgQual = Nothing
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_ghc(9,5,0)
|
||||
ideclImportList = Nothing
|
||||
|
||||
Loading…
Reference in New Issue
Block a user