{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS -Wno-incomplete-uni-patterns -Wno-dodgy-imports #-}
module Development.IDE.GHC.Compat(
mkHomeModLocation,
hPutStringBuffer,
addIncludePathsQuote,
getModuleHash,
setUpTypedHoles,
NameCacheUpdater(..),
#if MIN_VERSION_ghc(9,3,0)
getMessages,
renderDiagnosticMessageWithHints,
nameEnvElts,
#else
upNameCache,
#endif
lookupNameCache,
disableWarningsAsErrors,
reLoc,
reLocA,
getPsMessages,
renderMessages,
pattern PFailedWithErrorMessages,
isObjectLinkable,
#if !MIN_VERSION_ghc(9,0,1)
RefMap,
#endif
#if MIN_VERSION_ghc(9,2,0)
#if !MIN_VERSION_ghc(9,3,0)
extendModSummaryNoDeps,
emsModSummary,
#endif
myCoreToStgExpr,
#endif
Usage(..),
FastStringCompat,
bytesFS,
mkFastStringByteString,
nodeInfo',
getNodeIds,
sourceNodeInfo,
generatedNodeInfo,
simpleNodeInfoCompat,
isAnnotationInNodeInfo,
nodeAnnotations,
mkAstNode,
combineRealSrcSpans,
nonDetOccEnvElts,
isQualifiedImport,
GhcVersion(..),
ghcVersion,
ghcVersionStr,
HieFileResult(..),
HieFile(..),
hieExportNames,
mkHieFile',
enrichHie,
writeHieFile,
readHieFile,
supportsHieFiles,
setHieDir,
dontWriteHieFiles,
module Compat.HieTypes,
module Compat.HieUtils,
module Development.IDE.GHC.Compat.Core,
module Development.IDE.GHC.Compat.Env,
module Development.IDE.GHC.Compat.Iface,
module Development.IDE.GHC.Compat.Logger,
module Development.IDE.GHC.Compat.Outputable,
module Development.IDE.GHC.Compat.Parser,
module Development.IDE.GHC.Compat.Plugins,
module Development.IDE.GHC.Compat.Units,
Option (..),
runUnlit,
runPp,
hscCompileCoreExprHook,
CoreExpr,
simplifyExpr,
tidyExpr,
emptyTidyEnv,
corePrepExpr,
corePrepPgm,
lintInteractiveExpr,
icInteractiveModule,
HomePackageTable,
lookupHpt,
loadModulesHome,
#if MIN_VERSION_ghc(9,3,0)
Dependencies(dep_direct_mods),
#else
Dependencies(dep_mods),
#endif
bcoFreeNames,
ModIfaceAnnotation,
pattern Annotation,
AnnTarget(ModuleTarget),
extendAnnEnvList,
module UniqDSet,
module UniqSet,
module UniqDFM,
getDependentMods,
flattenBinds,
mkRnEnv2,
emptyInScopeSet,
Unfolding(..),
noUnfolding,
#if MIN_VERSION_ghc(9,2,0)
loadExpr,
byteCodeGen,
bc_bcos,
loadDecls,
hscInterp,
expectJust,
#else
coreExprToBCOs,
linkExpr,
#endif
extract_cons,
recDotDot,
#if MIN_VERSION_ghc(9,5,0)
XModulePs(..),
#endif
) where
import Data.Bifunctor
import Development.IDE.GHC.Compat.Core hiding (moduleUnitId)
import Development.IDE.GHC.Compat.Env
import Development.IDE.GHC.Compat.Iface
import Development.IDE.GHC.Compat.Logger
import Development.IDE.GHC.Compat.Outputable
import Development.IDE.GHC.Compat.Parser
import Development.IDE.GHC.Compat.Plugins
import Development.IDE.GHC.Compat.Units
import Development.IDE.GHC.Compat.Util
import GHC hiding (HasSrcSpan,
ModLocation,
RealSrcSpan, exprType,
getLoc, lookupName)
import Data.Coerce (coerce)
import Data.String (IsString (fromString))
#if MIN_VERSION_ghc(9,0,0)
#if MIN_VERSION_ghc(9,5,0)
import GHC.Core.Lint.Interactive (interactiveInScope)
import GHC.Driver.Config.Core.Lint.Interactive (lintInteractiveExpr)
import GHC.Driver.Config.Core.Opt.Simplify (initSimplifyExprOpts)
import GHC.Driver.Config.CoreToStg (initCoreToStgOpts)
import GHC.Driver.Config.CoreToStg.Prep (initCorePrepConfig)
#else
import GHC.Core.Lint (lintInteractiveExpr)
#endif
import qualified GHC.Core.Opt.Pipeline as GHC
import GHC.Core.Tidy (tidyExpr)
import GHC.CoreToStg.Prep (corePrepPgm)
import qualified GHC.CoreToStg.Prep as GHC
import GHC.Driver.Hooks (hscCompileCoreExprHook)
#if MIN_VERSION_ghc(9,2,0)
import GHC.Linker.Loader (loadExpr)
import GHC.Linker.Types (isObjectLinkable)
import GHC.Runtime.Context (icInteractiveModule)
import GHC.Unit.Home.ModInfo (HomePackageTable,
lookupHpt)
#if MIN_VERSION_ghc(9,3,0)
import GHC.Unit.Module.Deps (Dependencies(dep_direct_mods), Usage(..))
#else
import GHC.Unit.Module.Deps (Dependencies(dep_mods), Usage(..))
#endif
#else
import GHC.CoreToByteCode (coreExprToBCOs)
import GHC.Driver.Types (Dependencies (dep_mods),
HomePackageTable,
icInteractiveModule,
lookupHpt)
import GHC.Runtime.Linker (linkExpr)
#endif
import GHC.ByteCode.Asm (bcoFreeNames)
import GHC.Types.Annotations (AnnTarget (ModuleTarget),
Annotation (..),
extendAnnEnvList)
import GHC.Types.Unique.DFM as UniqDFM
import GHC.Types.Unique.DSet as UniqDSet
import GHC.Types.Unique.Set as UniqSet
#else
import Annotations (AnnTarget (ModuleTarget),
Annotation (..),
extendAnnEnvList)
import ByteCodeAsm (bcoFreeNames)
import ByteCodeGen (coreExprToBCOs)
import CoreLint (lintInteractiveExpr)
import CorePrep (corePrepExpr,
corePrepPgm)
import CoreSyn (CoreExpr,
Unfolding (..),
flattenBinds,
noUnfolding)
import CoreTidy (tidyExpr)
import Hooks (hscCompileCoreExprHook)
import Linker (linkExpr)
import qualified SimplCore as GHC
import UniqDFM
import UniqDSet
import UniqSet
import VarEnv (emptyInScopeSet,
emptyTidyEnv, mkRnEnv2)
#endif
#if MIN_VERSION_ghc(9,0,0)
import GHC.Data.FastString
import GHC.Core
import GHC.Data.StringBuffer
import GHC.Driver.Session hiding (ExposePackage)
import qualified GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Var.Env
import GHC.Utils.Error
#if MIN_VERSION_ghc(9,2,0)
import GHC.Driver.Env as Env
import GHC.Unit.Module.ModIface
import GHC.Unit.Module.ModSummary
#else
import GHC.Driver.Types
#endif
import GHC.Iface.Env
import GHC.Iface.Make (mkIfaceExports)
import qualified GHC.SysTools.Tasks as SysTools
import qualified GHC.Types.Avail as Avail
#else
import FastString
import qualified Avail
import DynFlags hiding (ExposePackage)
import HscTypes
import MkIface hiding (writeIfaceFile)
import StringBuffer (hPutStringBuffer)
import qualified SysTools
#endif
import Compat.HieAst (enrichHie)
import Compat.HieBin
import Compat.HieTypes hiding (nodeAnnotations)
import qualified Compat.HieTypes as GHC (nodeAnnotations)
import Compat.HieUtils
import qualified Data.ByteString as BS
import Data.IORef
import Data.List (foldl')
import qualified Data.Map as Map
import qualified Data.Set as S
#if MIN_VERSION_ghc(9,2,0)
import GHC.Builtin.Uniques
import GHC.ByteCode.Types
import GHC.CoreToStg
import GHC.Data.Maybe
import GHC.Linker.Loader (loadDecls)
import GHC.Runtime.Interpreter
import GHC.Stg.Pipeline
import GHC.Stg.Syntax
import GHC.StgToByteCode
import GHC.Types.CostCentre
import GHC.Types.IPE
#endif
#if MIN_VERSION_ghc(9,3,0)
import GHC.Types.Error
import GHC.Driver.Config.Stg.Pipeline
import GHC.Driver.Plugins (PsMessages (..))
#endif
#if !MIN_VERSION_ghc(9,3,0)
nonDetOccEnvElts :: OccEnv a -> [a]
nonDetOccEnvElts :: forall a. OccEnv a -> [a]
nonDetOccEnvElts = forall a. OccEnv a -> [a]
occEnvElts
#endif
type ModIfaceAnnotation = Annotation
#if MIN_VERSION_ghc(9,3,0)
nameEnvElts :: NameEnv a -> [a]
nameEnvElts = nonDetNameEnvElts
#endif
#if MIN_VERSION_ghc(9,2,0)
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]
#else
,[StgTopBinding]
#endif
, InfoTableProvMap
, CollectedCCs )
myCoreToStgExpr :: Logger
-> DynFlags
-> InteractiveContext
-> Module
-> ModLocation
-> CoreExpr
-> IO (Id, [StgTopBinding], InfoTableProvMap, CollectedCCs)
myCoreToStgExpr Logger
logger DynFlags
dflags InteractiveContext
ictxt
#if MIN_VERSION_ghc(9,3,0)
for_bytecode
#endif
Module
this_mod ModLocation
ml CoreExpr
prepd_expr = do
let bco_tmp_id :: Id
bco_tmp_id = FastString -> Unique -> Mult -> Mult -> Id
mkSysLocal (String -> FastString
fsLit String
"BCO_toplevel")
(TypeIndex -> Unique
mkPseudoUniqueE TypeIndex
0)
#if MIN_VERSION_ghc(9,5,0)
ManyTy
#else
Mult
Many
#endif
(CoreExpr -> Mult
exprType CoreExpr
prepd_expr)
([StgTopBinding]
stg_binds, InfoTableProvMap
prov_map, CollectedCCs
collected_ccs) <-
Logger
-> DynFlags
-> InteractiveContext
-> Module
-> ModLocation
-> CoreProgram
-> IO ([StgTopBinding], InfoTableProvMap, CollectedCCs)
myCoreToStg Logger
logger
DynFlags
dflags
InteractiveContext
ictxt
#if MIN_VERSION_ghc(9,3,0)
for_bytecode
#endif
Module
this_mod
ModLocation
ml
[forall b. b -> Expr b -> Bind b
NonRec Id
bco_tmp_id CoreExpr
prepd_expr]
forall (m :: * -> *) a. Monad m => a -> m a
return (Id
bco_tmp_id, [StgTopBinding]
stg_binds, InfoTableProvMap
prov_map, CollectedCCs
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]
#else
-> IO ( [StgTopBinding]
#endif
, InfoTableProvMap
, CollectedCCs )
myCoreToStg :: Logger
-> DynFlags
-> InteractiveContext
-> Module
-> ModLocation
-> CoreProgram
-> IO ([StgTopBinding], InfoTableProvMap, CollectedCCs)
myCoreToStg Logger
logger DynFlags
dflags InteractiveContext
ictxt
#if MIN_VERSION_ghc(9,3,0)
for_bytecode
#endif
Module
this_mod ModLocation
ml CoreProgram
prepd_binds = do
let ([StgTopBinding]
stg_binds, InfoTableProvMap
denv, CollectedCCs
cost_centre_info)
= {-# SCC "Core2Stg" #-}
DynFlags
-> Module
-> ModLocation
-> CoreProgram
-> ([StgTopBinding], InfoTableProvMap, CollectedCCs)
coreToStg
#if MIN_VERSION_ghc(9,5,0)
(initCoreToStgOpts dflags)
#else
DynFlags
dflags
#endif
Module
this_mod ModLocation
ml CoreProgram
prepd_binds
#if MIN_VERSION_ghc(9,4,2)
(stg_binds2,_)
#else
[StgTopBinding]
stg_binds2
#endif
<- {-# SCC "Stg2Stg" #-}
#if MIN_VERSION_ghc(9,3,0)
stg2stg logger
#if MIN_VERSION_ghc(9,5,0)
(interactiveInScope ictxt)
#else
ictxt
#endif
(initStgPipelineOpts dflags for_bytecode) this_mod stg_binds
#else
Logger
-> DynFlags
-> InteractiveContext
-> Module
-> [StgTopBinding]
-> IO [StgTopBinding]
stg2stg Logger
logger DynFlags
dflags InteractiveContext
ictxt Module
this_mod [StgTopBinding]
stg_binds
#endif
forall (m :: * -> *) a. Monad m => a -> m a
return ([StgTopBinding]
stg_binds2, InfoTableProvMap
denv, CollectedCCs
cost_centre_info)
#endif
#if !MIN_VERSION_ghc(9,2,0)
reLoc :: Located a -> Located a
reLoc = id
reLocA :: Located a -> Located a
reLocA = id
#endif
getDependentMods :: ModIface -> [ModuleName]
#if MIN_VERSION_ghc(9,3,0)
getDependentMods = map (gwib_mod . snd) . S.toList . dep_direct_mods . mi_deps
#elif MIN_VERSION_ghc(9,0,0)
getDependentMods :: ModIface -> [ModuleName]
getDependentMods = forall a b. (a -> b) -> [a] -> [b]
map forall mod. GenWithIsBoot mod -> mod
gwib_mod forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependencies -> [GenWithIsBoot ModuleName]
dep_mods forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps
#else
getDependentMods = map fst . dep_mods . mi_deps
#endif
simplifyExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr
#if MIN_VERSION_ghc(9,0,0)
#if MIN_VERSION_ghc(9,5,0)
simplifyExpr _ env = GHC.simplifyExpr (Development.IDE.GHC.Compat.Env.hsc_logger env) (ue_eps (Development.IDE.GHC.Compat.Env.hsc_unit_env env)) (initSimplifyExprOpts (hsc_dflags env) (hsc_IC env))
#else
simplifyExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr
simplifyExpr DynFlags
_ = HscEnv -> CoreExpr -> IO CoreExpr
GHC.simplifyExpr
#endif
corePrepExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr
#if MIN_VERSION_ghc(9,5,0)
corePrepExpr _ env exp = do
cfg <- initCorePrepConfig env
GHC.corePrepExpr (Development.IDE.GHC.Compat.Env.hsc_logger env) cfg exp
#else
corePrepExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr
corePrepExpr DynFlags
_ = HscEnv -> CoreExpr -> IO CoreExpr
GHC.corePrepExpr
#endif
#else
simplifyExpr df _ = GHC.simplifyExpr df
#endif
renderMessages :: PsMessages -> (Bag WarnMsg, Bag ErrMsg)
renderMessages :: PsMessages -> PsMessages
renderMessages PsMessages
msgs =
#if MIN_VERSION_ghc(9,3,0)
let renderMsgs extractor = (fmap . fmap) renderDiagnosticMessageWithHints . getMessages $ extractor msgs
in (renderMsgs psWarnings, renderMsgs psErrors)
#else
PsMessages
msgs
#endif
#if MIN_VERSION_ghc(9,2,0)
pattern PFailedWithErrorMessages :: forall a b. (b -> Bag (MsgEnvelope DecoratedSDoc)) -> ParseResult a
pattern $mPFailedWithErrorMessages :: forall {r} {a} {b}.
ParseResult a
-> ((b -> Bag (MsgEnvelope DecoratedSDoc)) -> r)
-> ((# #) -> r)
-> r
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
#else
pattern PFailedWithErrorMessages :: (DynFlags -> ErrorMessages) -> ParseResult a
pattern PFailedWithErrorMessages msgs
<- PFailed (getErrorMessages -> msgs)
#endif
{-# COMPLETE POk, PFailedWithErrorMessages #-}
supportsHieFiles :: Bool
supportsHieFiles :: Bool
supportsHieFiles = Bool
True
hieExportNames :: HieFile -> [(SrcSpan, Name)]
hieExportNames :: HieFile -> [(SrcSpan, Name)]
hieExportNames = [AvailInfo] -> [(SrcSpan, Name)]
nameListFromAvails forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieFile -> [AvailInfo]
hie_exports
#if MIN_VERSION_ghc(9,3,0)
type NameCacheUpdater = NameCache
#else
lookupNameCache :: Module -> OccName -> NameCache -> (NameCache, Name)
lookupNameCache :: Module -> OccName -> NameCache -> (NameCache, Name)
lookupNameCache Module
mod OccName
occ NameCache
name_cache =
case OrigNameCache -> Module -> OccName -> Maybe Name
lookupOrigNameCache (NameCache -> OrigNameCache
nsNames NameCache
name_cache) Module
mod OccName
occ of {
Just Name
name -> (NameCache
name_cache, Name
name);
Maybe Name
Nothing ->
case UniqSupply -> (Unique, UniqSupply)
takeUniqFromSupply (NameCache -> UniqSupply
nsUniqs NameCache
name_cache) of {
(Unique
uniq, UniqSupply
us) ->
let
name :: Name
name = Unique -> Module -> OccName -> SrcSpan -> Name
mkExternalName Unique
uniq Module
mod OccName
occ SrcSpan
noSrcSpan
new_cache :: OrigNameCache
new_cache = OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
extendNameCache (NameCache -> OrigNameCache
nsNames NameCache
name_cache) Module
mod OccName
occ Name
name
in (NameCache
name_cache{ nsUniqs :: UniqSupply
nsUniqs = UniqSupply
us, nsNames :: OrigNameCache
nsNames = OrigNameCache
new_cache }, Name
name) }}
upNameCache :: IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
upNameCache :: forall c. IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
upNameCache = forall c. IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
updNameCache
#endif
#if !MIN_VERSION_ghc(9,0,1)
type RefMap a = Map.Map Identifier [(Span, IdentifierDetails a)]
#endif
mkHieFile' :: ModSummary
-> [Avail.AvailInfo]
-> HieASTs Type
-> BS.ByteString
-> Hsc HieFile
mkHieFile' :: ModSummary
-> [AvailInfo] -> HieASTs Mult -> ByteString -> Hsc HieFile
mkHieFile' ModSummary
ms [AvailInfo]
exports HieASTs Mult
asts ByteString
src = do
let Just String
src_file = ModLocation -> Maybe String
ml_hs_file forall a b. (a -> b) -> a -> b
$ ModSummary -> ModLocation
ms_location ModSummary
ms
(HieASTs TypeIndex
asts',Array TypeIndex HieTypeFlat
arr) = HieASTs Mult -> (HieASTs TypeIndex, Array TypeIndex HieTypeFlat)
compressTypes HieASTs Mult
asts
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ HieFile
{ hie_hs_file :: String
hie_hs_file = String
src_file
, hie_module :: Module
hie_module = ModSummary -> Module
ms_mod ModSummary
ms
, hie_types :: Array TypeIndex HieTypeFlat
hie_types = Array TypeIndex HieTypeFlat
arr
, hie_asts :: HieASTs TypeIndex
hie_asts = HieASTs TypeIndex
asts'
, hie_exports :: [AvailInfo]
hie_exports = [AvailInfo] -> [AvailInfo]
mkIfaceExports [AvailInfo]
exports
, hie_hs_src :: ByteString
hie_hs_src = ByteString
src
}
addIncludePathsQuote :: FilePath -> DynFlags -> DynFlags
addIncludePathsQuote :: String -> DynFlags -> DynFlags
addIncludePathsQuote String
path DynFlags
x = DynFlags
x{includePaths :: IncludeSpecs
includePaths = IncludeSpecs -> IncludeSpecs
f forall a b. (a -> b) -> a -> b
$ DynFlags -> IncludeSpecs
includePaths DynFlags
x}
where f :: IncludeSpecs -> IncludeSpecs
f IncludeSpecs
i = IncludeSpecs
i{includePathsQuote :: [String]
includePathsQuote = String
path forall a. a -> [a] -> [a]
: IncludeSpecs -> [String]
includePathsQuote IncludeSpecs
i}
setHieDir :: FilePath -> DynFlags -> DynFlags
setHieDir :: String -> DynFlags -> DynFlags
setHieDir String
_f DynFlags
d = DynFlags
d { hieDir :: Maybe String
hieDir = forall a. a -> Maybe a
Just String
_f}
dontWriteHieFiles :: DynFlags -> DynFlags
dontWriteHieFiles :: DynFlags -> DynFlags
dontWriteHieFiles DynFlags
d = DynFlags -> GeneralFlag -> DynFlags
gopt_unset DynFlags
d GeneralFlag
Opt_WriteHie
setUpTypedHoles ::DynFlags -> DynFlags
setUpTypedHoles :: DynFlags -> DynFlags
setUpTypedHoles DynFlags
df
= forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_AbstractRefHoleFits
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowDocsOfHoleFits
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowMatchesOfHoleFits
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowProvOfHoleFits
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowTypeAppOfHoleFits
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowTypeAppVarsOfHoleFits
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowTypeOfHoleFits
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_set GeneralFlag
Opt_SortBySubsumHoleFits
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_SortValidHoleFits
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_UnclutterValidHoleFits
forall a b. (a -> b) -> a -> b
$ DynFlags
df
{ refLevelHoleFits :: Maybe TypeIndex
refLevelHoleFits = forall a. a -> Maybe a
Just TypeIndex
1
, maxRefHoleFits :: Maybe TypeIndex
maxRefHoleFits = forall a. a -> Maybe a
Just TypeIndex
10
, maxValidHoleFits :: Maybe TypeIndex
maxValidHoleFits = forall a. Maybe a
Nothing
}
nameListFromAvails :: [Avail.AvailInfo] -> [(SrcSpan, Name)]
nameListFromAvails :: [AvailInfo] -> [(SrcSpan, Name)]
nameListFromAvails [AvailInfo]
as =
forall a b. (a -> b) -> [a] -> [b]
map (\Name
n -> (Name -> SrcSpan
nameSrcSpan Name
n, Name
n)) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [Name]
Avail.availNames [AvailInfo]
as)
getModuleHash :: ModIface -> Fingerprint
getModuleHash :: ModIface -> Fingerprint
getModuleHash = ModIfaceBackend -> Fingerprint
mi_mod_hash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts
disableWarningsAsErrors :: DynFlags -> DynFlags
disableWarningsAsErrors :: DynFlags -> DynFlags
disableWarningsAsErrors DynFlags
df =
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_WarnIsError forall a b. (a -> b) -> a -> b
$! forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' DynFlags -> WarningFlag -> DynFlags
wopt_unset_fatal DynFlags
df [forall a. Enum a => TypeIndex -> a
toEnum TypeIndex
0 ..]
isQualifiedImport :: ImportDecl a -> Bool
isQualifiedImport :: forall a. ImportDecl a -> Bool
isQualifiedImport ImportDecl{ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified = ImportDeclQualifiedStyle
NotQualified} = Bool
False
isQualifiedImport ImportDecl{} = Bool
True
isQualifiedImport ImportDecl a
_ = Bool
False
#if MIN_VERSION_ghc(9,0,0)
getNodeIds :: HieAST a -> Map.Map Identifier (IdentifierDetails a)
getNodeIds :: forall a. HieAST a -> Map Identifier (IdentifierDetails a)
getNodeIds = forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' forall a.
Map Identifier (IdentifierDetails a)
-> NodeInfo a -> Map Identifier (IdentifierDetails a)
combineNodeIds forall k a. Map k a
Map.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo
combineNodeIds :: Map.Map Identifier (IdentifierDetails a)
-> NodeInfo a -> Map.Map Identifier (IdentifierDetails a)
Map Identifier (IdentifierDetails a)
ad combineNodeIds :: forall a.
Map Identifier (IdentifierDetails a)
-> NodeInfo a -> Map Identifier (IdentifierDetails a)
`combineNodeIds` (NodeInfo Set NodeAnnotation
_ [a]
_ Map Identifier (IdentifierDetails a)
bd) = forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall a. Semigroup a => a -> a -> a
(<>) Map Identifier (IdentifierDetails a)
ad Map Identifier (IdentifierDetails a)
bd
nodeInfo' :: HieAST TypeIndex -> NodeInfo TypeIndex
nodeInfo' :: HieAST TypeIndex -> NodeInfo TypeIndex
nodeInfo' = forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' forall a. Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a
combineNodeInfo' forall a. NodeInfo a
emptyNodeInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo
combineNodeInfo' :: Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a
(NodeInfo Set NodeAnnotation
as [a]
ai NodeIdentifiers a
ad) combineNodeInfo' :: forall a. Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a
`combineNodeInfo'` (NodeInfo Set NodeAnnotation
bs [a]
bi NodeIdentifiers a
bd) =
forall a.
Set NodeAnnotation -> [a] -> NodeIdentifiers a -> NodeInfo a
NodeInfo (forall a. Ord a => Set a -> Set a -> Set a
S.union Set NodeAnnotation
as Set NodeAnnotation
bs) (forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
ai [a]
bi) (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall a. Semigroup a => a -> a -> a
(<>) NodeIdentifiers a
ad NodeIdentifiers a
bd)
where
mergeSorted :: Ord a => [a] -> [a] -> [a]
mergeSorted :: forall a. Ord a => [a] -> [a] -> [a]
mergeSorted la :: [a]
la@(a
a:[a]
as) lb :: [a]
lb@(a
b:[a]
bs) = case forall a. Ord a => a -> a -> Ordering
compare a
a a
b of
Ordering
LT -> a
a forall a. a -> [a] -> [a]
: forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
as [a]
lb
Ordering
EQ -> a
a forall a. a -> [a] -> [a]
: forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
as [a]
bs
Ordering
GT -> a
b forall a. a -> [a] -> [a]
: forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
la [a]
bs
mergeSorted [a]
as [] = [a]
as
mergeSorted [] [a]
bs = [a]
bs
#else
getNodeIds :: HieAST a -> NodeIdentifiers a
getNodeIds = nodeIdentifiers . nodeInfo
nodeInfo' :: Ord a => HieAST a -> NodeInfo a
nodeInfo' = nodeInfo
#endif
sourceNodeInfo :: HieAST a -> Maybe (NodeInfo a)
#if MIN_VERSION_ghc(9,0,0)
sourceNodeInfo :: forall a. HieAST a -> Maybe (NodeInfo a)
sourceNodeInfo = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NodeOrigin
SourceInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo
#else
sourceNodeInfo = Just . nodeInfo
#endif
generatedNodeInfo :: HieAST a -> Maybe (NodeInfo a)
#if MIN_VERSION_ghc(9,0,0)
generatedNodeInfo :: forall a. HieAST a -> Maybe (NodeInfo a)
generatedNodeInfo = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NodeOrigin
GeneratedInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo
#else
generatedNodeInfo = sourceNodeInfo
#endif
data GhcVersion
= GHC810
| GHC90
| GHC92
| GHC94
| GHC96
deriving (GhcVersion -> GhcVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GhcVersion -> GhcVersion -> Bool
$c/= :: GhcVersion -> GhcVersion -> Bool
== :: GhcVersion -> GhcVersion -> Bool
$c== :: GhcVersion -> GhcVersion -> Bool
Eq, Eq GhcVersion
GhcVersion -> GhcVersion -> Bool
GhcVersion -> GhcVersion -> Ordering
GhcVersion -> GhcVersion -> GhcVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GhcVersion -> GhcVersion -> GhcVersion
$cmin :: GhcVersion -> GhcVersion -> GhcVersion
max :: GhcVersion -> GhcVersion -> GhcVersion
$cmax :: GhcVersion -> GhcVersion -> GhcVersion
>= :: GhcVersion -> GhcVersion -> Bool
$c>= :: GhcVersion -> GhcVersion -> Bool
> :: GhcVersion -> GhcVersion -> Bool
$c> :: GhcVersion -> GhcVersion -> Bool
<= :: GhcVersion -> GhcVersion -> Bool
$c<= :: GhcVersion -> GhcVersion -> Bool
< :: GhcVersion -> GhcVersion -> Bool
$c< :: GhcVersion -> GhcVersion -> Bool
compare :: GhcVersion -> GhcVersion -> Ordering
$ccompare :: GhcVersion -> GhcVersion -> Ordering
Ord, TypeIndex -> GhcVersion -> ShowS
[GhcVersion] -> ShowS
GhcVersion -> String
forall a.
(TypeIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GhcVersion] -> ShowS
$cshowList :: [GhcVersion] -> ShowS
show :: GhcVersion -> String
$cshow :: GhcVersion -> String
showsPrec :: TypeIndex -> GhcVersion -> ShowS
$cshowsPrec :: TypeIndex -> GhcVersion -> ShowS
Show)
ghcVersionStr :: String
ghcVersionStr :: String
ghcVersionStr = VERSION_ghc
ghcVersion :: GhcVersion
#if MIN_VERSION_GLASGOW_HASKELL(9,6,0,0)
ghcVersion = GHC96
#elif MIN_VERSION_GLASGOW_HASKELL(9,4,0,0)
ghcVersion = GHC94
#elif MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)
ghcVersion :: GhcVersion
ghcVersion = GhcVersion
GHC92
#elif MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)
ghcVersion = GHC90
#elif MIN_VERSION_GLASGOW_HASKELL(8,10,0,0)
ghcVersion = GHC810
#endif
runUnlit :: Logger -> DynFlags -> [Option] -> IO ()
runUnlit :: Logger -> DynFlags -> [Option] -> IO ()
runUnlit =
#if MIN_VERSION_ghc(9,2,0)
Logger -> DynFlags -> [Option] -> IO ()
SysTools.runUnlit
#else
const SysTools.runUnlit
#endif
runPp :: Logger -> DynFlags -> [Option] -> IO ()
runPp :: Logger -> DynFlags -> [Option] -> IO ()
runPp =
#if MIN_VERSION_ghc(9,2,0)
Logger -> DynFlags -> [Option] -> IO ()
SysTools.runPp
#else
const SysTools.runPp
#endif
simpleNodeInfoCompat :: FastStringCompat -> FastStringCompat -> NodeInfo a
simpleNodeInfoCompat :: forall a. FastStringCompat -> FastStringCompat -> NodeInfo a
simpleNodeInfoCompat FastStringCompat
ctor FastStringCompat
typ = forall a. FastString -> FastString -> NodeInfo a
simpleNodeInfo (coerce :: forall a b. Coercible a b => a -> b
coerce FastStringCompat
ctor) (coerce :: forall a b. Coercible a b => a -> b
coerce FastStringCompat
typ)
isAnnotationInNodeInfo :: (FastStringCompat, FastStringCompat) -> NodeInfo a -> Bool
isAnnotationInNodeInfo :: forall a.
(FastStringCompat, FastStringCompat) -> NodeInfo a -> Bool
isAnnotationInNodeInfo (FastStringCompat, FastStringCompat)
p = forall a. Ord a => a -> Set a -> Bool
S.member (FastStringCompat, FastStringCompat)
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NodeInfo a -> Set (FastStringCompat, FastStringCompat)
nodeAnnotations
nodeAnnotations :: NodeInfo a -> S.Set (FastStringCompat, FastStringCompat)
#if MIN_VERSION_ghc(9,2,0)
nodeAnnotations :: forall a. NodeInfo a -> Set (FastStringCompat, FastStringCompat)
nodeAnnotations = forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (\(NodeAnnotation FastString
ctor FastString
typ) -> (coerce :: forall a b. Coercible a b => a -> b
coerce FastString
ctor, coerce :: forall a b. Coercible a b => a -> b
coerce FastString
typ)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NodeInfo a -> Set NodeAnnotation
GHC.nodeAnnotations
#else
nodeAnnotations = S.map (bimap coerce coerce) . GHC.nodeAnnotations
#endif
#if MIN_VERSION_ghc(9,2,0)
newtype FastStringCompat = FastStringCompat LexicalFastString
#else
newtype FastStringCompat = FastStringCompat FastString
#endif
deriving (TypeIndex -> FastStringCompat -> ShowS
[FastStringCompat] -> ShowS
FastStringCompat -> String
forall a.
(TypeIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FastStringCompat] -> ShowS
$cshowList :: [FastStringCompat] -> ShowS
show :: FastStringCompat -> String
$cshow :: FastStringCompat -> String
showsPrec :: TypeIndex -> FastStringCompat -> ShowS
$cshowsPrec :: TypeIndex -> FastStringCompat -> ShowS
Show, FastStringCompat -> FastStringCompat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FastStringCompat -> FastStringCompat -> Bool
$c/= :: FastStringCompat -> FastStringCompat -> Bool
== :: FastStringCompat -> FastStringCompat -> Bool
$c== :: FastStringCompat -> FastStringCompat -> Bool
Eq, Eq FastStringCompat
FastStringCompat -> FastStringCompat -> Bool
FastStringCompat -> FastStringCompat -> Ordering
FastStringCompat -> FastStringCompat -> FastStringCompat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FastStringCompat -> FastStringCompat -> FastStringCompat
$cmin :: FastStringCompat -> FastStringCompat -> FastStringCompat
max :: FastStringCompat -> FastStringCompat -> FastStringCompat
$cmax :: FastStringCompat -> FastStringCompat -> FastStringCompat
>= :: FastStringCompat -> FastStringCompat -> Bool
$c>= :: FastStringCompat -> FastStringCompat -> Bool
> :: FastStringCompat -> FastStringCompat -> Bool
$c> :: FastStringCompat -> FastStringCompat -> Bool
<= :: FastStringCompat -> FastStringCompat -> Bool
$c<= :: FastStringCompat -> FastStringCompat -> Bool
< :: FastStringCompat -> FastStringCompat -> Bool
$c< :: FastStringCompat -> FastStringCompat -> Bool
compare :: FastStringCompat -> FastStringCompat -> Ordering
$ccompare :: FastStringCompat -> FastStringCompat -> Ordering
Ord)
instance IsString FastStringCompat where
#if MIN_VERSION_ghc(9,2,0)
fromString :: String -> FastStringCompat
fromString = LexicalFastString -> FastStringCompat
FastStringCompat forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> LexicalFastString
LexicalFastString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
#else
fromString = FastStringCompat . fromString
#endif
mkAstNode :: NodeInfo a -> Span -> [HieAST a] -> HieAST a
#if MIN_VERSION_ghc(9,0,0)
mkAstNode :: forall a. NodeInfo a -> Span -> [HieAST a] -> HieAST a
mkAstNode NodeInfo a
n = forall a. SourcedNodeInfo a -> Span -> [HieAST a] -> HieAST a
Node (forall a. Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a
SourcedNodeInfo forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton NodeOrigin
GeneratedInfo NodeInfo a
n)
#else
mkAstNode = Node
#endif
combineRealSrcSpans :: RealSrcSpan -> RealSrcSpan -> RealSrcSpan
#if MIN_VERSION_ghc(9,2,0)
combineRealSrcSpans :: Span -> Span -> Span
combineRealSrcSpans = Span -> Span -> Span
SrcLoc.combineRealSrcSpans
#else
combineRealSrcSpans span1 span2
= mkRealSrcSpan (mkRealSrcLoc file line_start col_start) (mkRealSrcLoc file line_end col_end)
where
(line_start, col_start) = min (srcSpanStartLine span1, srcSpanStartCol span1)
(srcSpanStartLine span2, srcSpanStartCol span2)
(line_end, col_end) = max (srcSpanEndLine span1, srcSpanEndCol span1)
(srcSpanEndLine span2, srcSpanEndCol span2)
file = srcSpanFile span1
#endif
loadModulesHome
:: [HomeModInfo]
-> HscEnv
-> HscEnv
loadModulesHome :: [HomeModInfo] -> HscEnv -> HscEnv
loadModulesHome [HomeModInfo]
mod_infos HscEnv
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 :: HomePackageTable
new_modules = HomePackageTable -> [(ModuleName, HomeModInfo)] -> HomePackageTable
addListToHpt (HscEnv -> HomePackageTable
hsc_HPT HscEnv
e) [(HomeModInfo -> ModuleName
mod_name HomeModInfo
x, HomeModInfo
x) | HomeModInfo
x <- [HomeModInfo]
mod_infos]
in HscEnv
e { hsc_HPT :: HomePackageTable
hsc_HPT = HomePackageTable
new_modules
, hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
hsc_type_env_var = forall a. Maybe a
Nothing
}
where
mod_name :: HomeModInfo -> ModuleName
mod_name = forall unit. GenModule unit -> ModuleName
moduleName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModIface
hm_iface
#endif
recDotDot :: HsRecFields (GhcPass p) arg -> Maybe Int
recDotDot :: forall (p :: Pass) arg.
HsRecFields (GhcPass p) arg -> Maybe TypeIndex
recDotDot HsRecFields (GhcPass p) arg
x =
#if MIN_VERSION_ghc(9,5,0)
unRecFieldsDotDot <$>
#endif
forall l e. GenLocated l e -> e
unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p arg. HsRecFields p arg -> Maybe (Located TypeIndex)
rec_dotdot HsRecFields (GhcPass p) arg
x
#if MIN_VERSION_ghc(9,5,0)
extract_cons (NewTypeCon x) = [x]
extract_cons (DataTypeCons _ xs) = xs
#else
= forall a. a -> a
id
#endif