{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternSynonyms #-}
module Development.IDE.GHC.Compat(
hPutStringBuffer,
addIncludePathsQuote,
getModuleHash,
setUpTypedHoles,
lookupNameCache,
disableWarningsAsErrors,
reLoc,
reLocA,
renderMessages,
pattern PFailedWithErrorMessages,
myCoreToStgExpr,
Usage(..),
FastStringCompat,
bytesFS,
mkFastStringByteString,
nodeInfo',
getNodeIds,
getSourceNodeIds,
sourceNodeInfo,
generatedNodeInfo,
simpleNodeInfoCompat,
isAnnotationInNodeInfo,
nodeAnnotations,
mkAstNode,
combineRealSrcSpans,
isQualifiedImport,
GhcVersion(..),
ghcVersion,
ghcVersionStr,
HieFileResult(..),
HieFile(..),
hieExportNames,
mkHieFile',
enrichHie,
writeHieFile,
readHieFile,
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,
bcoFreeNames,
ModIfaceAnnotation,
pattern Annotation,
AnnTarget(ModuleTarget),
extendAnnEnvList,
module UniqDSet,
module UniqSet,
module UniqDFM,
getDependentMods,
flattenBinds,
mkRnEnv2,
emptyInScopeSet,
Unfolding(..),
noUnfolding,
loadExpr,
byteCodeGen,
bc_bcos,
loadDecls,
hscInterp,
expectJust,
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(..),
#endif
#if !MIN_VERSION_ghc(9,7,0)
liftZonkM,
nonDetFoldOccEnv,
#endif
#if MIN_VERSION_ghc(9,7,0)
tcInitTidyEnv,
#endif
) where
import Compat.HieAst (enrichHie)
import Compat.HieBin
import Compat.HieTypes hiding
(nodeAnnotations)
import qualified Compat.HieTypes as GHC (nodeAnnotations)
import Compat.HieUtils
import Control.Applicative ((<|>))
import qualified Data.ByteString as BS
import Data.Coerce (coerce)
import Data.List (foldl')
import qualified Data.Map as Map
import qualified Data.Set as S
import Data.String (IsString (fromString))
import Development.IDE.GHC.Compat.Core
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 (ModLocation,
RealSrcSpan, exprType,
getLoc, lookupName)
import Prelude hiding (mod)
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)
import GHC.ByteCode.Asm (bcoFreeNames)
import GHC.Core
import GHC.Data.FastString
import GHC.Data.StringBuffer
import GHC.Driver.Session hiding (ExposePackage)
import GHC.Iface.Make (mkIfaceExports)
import GHC.SysTools.Tasks (runPp, runUnlit)
import GHC.Types.Annotations (AnnTarget (ModuleTarget),
Annotation (..),
extendAnnEnvList)
import qualified GHC.Types.Avail as Avail
import GHC.Types.Unique.DFM as UniqDFM
import GHC.Types.Unique.DSet as UniqDSet
import GHC.Types.Unique.Set as UniqSet
import GHC.Types.Var.Env
import GHC.Builtin.Uniques
import GHC.ByteCode.Types
import GHC.CoreToStg
import GHC.Data.Maybe
import GHC.Driver.Env as Env
import GHC.Iface.Env
import GHC.Linker.Loader (loadDecls, loadExpr)
import GHC.Runtime.Context (icInteractiveModule)
import GHC.Stg.Pipeline
import GHC.Stg.Syntax
import GHC.StgToByteCode
import GHC.Types.CostCentre
import GHC.Types.IPE
import GHC.Types.SrcLoc (combineRealSrcSpans)
import GHC.Unit.Home.ModInfo (HomePackageTable,
lookupHpt)
import GHC.Unit.Module.ModIface
#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)
#endif
#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)
#endif
#if MIN_VERSION_ghc(9,7,0)
import GHC.Tc.Zonk.TcType (tcInitTidyEnv)
#endif
#if !MIN_VERSION_ghc(9,7,0)
liftZonkM :: a -> a
liftZonkM :: forall a. a -> a
liftZonkM = a -> a
forall a. a -> a
id
nonDetFoldOccEnv :: (a -> b -> b) -> b -> OccEnv a -> b
nonDetFoldOccEnv :: forall a b. (a -> b -> b) -> b -> OccEnv a -> b
nonDetFoldOccEnv = (a -> b -> b) -> b -> OccEnv a -> b
forall a b. (a -> b -> b) -> b -> OccEnv a -> b
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]
#else
,[StgTopBinding]
#endif
, InfoTableProvMap
, CollectedCCs )
myCoreToStgExpr :: Logger
-> DynFlags
-> InteractiveContext
-> Bool
-> Module
-> ModLocation
-> CoreExpr
-> IO (Id, [CgStgTopBinding], InfoTableProvMap, CollectedCCs)
myCoreToStgExpr Logger
logger DynFlags
dflags InteractiveContext
ictxt
#if MIN_VERSION_ghc(9,3,0)
Bool
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")
(Int -> Unique
mkPseudoUniqueE Int
0)
#if MIN_VERSION_ghc(9,5,0)
Mult
ManyTy
#else
Many
#endif
((() :: Constraint) => CoreExpr -> Mult
CoreExpr -> Mult
exprType CoreExpr
prepd_expr)
([CgStgTopBinding]
stg_binds, InfoTableProvMap
prov_map, CollectedCCs
collected_ccs) <-
Logger
-> DynFlags
-> InteractiveContext
-> Bool
-> Module
-> ModLocation
-> CoreProgram
-> IO ([CgStgTopBinding], InfoTableProvMap, CollectedCCs)
myCoreToStg Logger
logger
DynFlags
dflags
InteractiveContext
ictxt
#if MIN_VERSION_ghc(9,3,0)
Bool
for_bytecode
#endif
Module
this_mod
ModLocation
ml
[Id -> CoreExpr -> Bind Id
forall b. b -> Expr b -> Bind b
NonRec Id
bco_tmp_id CoreExpr
prepd_expr]
(Id, [CgStgTopBinding], InfoTableProvMap, CollectedCCs)
-> IO (Id, [CgStgTopBinding], InfoTableProvMap, CollectedCCs)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Id
bco_tmp_id, [CgStgTopBinding]
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
-> Bool
-> Module
-> ModLocation
-> CoreProgram
-> IO ([CgStgTopBinding], InfoTableProvMap, CollectedCCs)
myCoreToStg Logger
logger DynFlags
dflags InteractiveContext
ictxt
#if MIN_VERSION_ghc(9,3,0)
Bool
for_bytecode
#endif
Module
this_mod ModLocation
ml CoreProgram
prepd_binds = do
let ([StgTopBinding]
stg_binds, InfoTableProvMap
denv, CollectedCCs
cost_centre_info)
= {-# SCC "Core2Stg" #-}
CoreToStgOpts
-> Module
-> ModLocation
-> CoreProgram
-> ([StgTopBinding], InfoTableProvMap, CollectedCCs)
coreToStg
#if MIN_VERSION_ghc(9,5,0)
(DynFlags -> CoreToStgOpts
initCoreToStgOpts DynFlags
dflags)
#else
dflags
#endif
Module
this_mod ModLocation
ml CoreProgram
prepd_binds
#if MIN_VERSION_ghc(9,8,0)
(unzip -> (stg_binds2,_),_)
#elif MIN_VERSION_ghc(9,4,2)
([CgStgTopBinding]
stg_binds2,StgCgInfos
_)
#else
stg_binds2
#endif
<- {-# SCC "Stg2Stg" #-}
#if MIN_VERSION_ghc(9,3,0)
Logger
-> [Id]
-> StgPipelineOpts
-> Module
-> [StgTopBinding]
-> IO ([CgStgTopBinding], StgCgInfos)
stg2stg Logger
logger
#if MIN_VERSION_ghc(9,5,0)
(InteractiveContext -> [Id]
interactiveInScope InteractiveContext
ictxt)
#else
ictxt
#endif
(DynFlags -> Bool -> StgPipelineOpts
initStgPipelineOpts DynFlags
dflags Bool
for_bytecode) Module
this_mod [StgTopBinding]
stg_binds
#else
stg2stg logger dflags ictxt this_mod stg_binds
#endif
([CgStgTopBinding], InfoTableProvMap, CollectedCCs)
-> IO ([CgStgTopBinding], InfoTableProvMap, CollectedCCs)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CgStgTopBinding]
stg_binds2, InfoTableProvMap
denv, CollectedCCs
cost_centre_info)
#if MIN_VERSION_ghc(9,9,0)
reLocA :: (HasLoc (GenLocated a e), HasAnnotation b)
=> GenLocated a e -> GenLocated b e
reLocA = reLoc
#endif
getDependentMods :: ModIface -> [ModuleName]
#if MIN_VERSION_ghc(9,3,0)
getDependentMods :: ModIface -> [ModuleName]
getDependentMods = ((UnitId, GenWithIsBoot ModuleName) -> ModuleName)
-> [(UnitId, GenWithIsBoot ModuleName)] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (GenWithIsBoot ModuleName -> ModuleName
forall mod. GenWithIsBoot mod -> mod
gwib_mod (GenWithIsBoot ModuleName -> ModuleName)
-> ((UnitId, GenWithIsBoot ModuleName) -> GenWithIsBoot ModuleName)
-> (UnitId, GenWithIsBoot ModuleName)
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitId, GenWithIsBoot ModuleName) -> GenWithIsBoot ModuleName
forall a b. (a, b) -> b
snd) ([(UnitId, GenWithIsBoot ModuleName)] -> [ModuleName])
-> (ModIface -> [(UnitId, GenWithIsBoot ModuleName)])
-> ModIface
-> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (UnitId, GenWithIsBoot ModuleName)
-> [(UnitId, GenWithIsBoot ModuleName)]
forall a. Set a -> [a]
S.toList (Set (UnitId, GenWithIsBoot ModuleName)
-> [(UnitId, GenWithIsBoot ModuleName)])
-> (ModIface -> Set (UnitId, GenWithIsBoot ModuleName))
-> ModIface
-> [(UnitId, GenWithIsBoot ModuleName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependencies -> Set (UnitId, GenWithIsBoot ModuleName)
dep_direct_mods (Dependencies -> Set (UnitId, GenWithIsBoot ModuleName))
-> (ModIface -> Dependencies)
-> ModIface
-> Set (UnitId, GenWithIsBoot ModuleName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
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)
simplifyExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr
simplifyExpr DynFlags
_ HscEnv
env = Logger
-> ExternalUnitCache -> SimplifyExprOpts -> CoreExpr -> IO CoreExpr
GHC.simplifyExpr (HscEnv -> Logger
Development.IDE.GHC.Compat.Env.hsc_logger HscEnv
env) (UnitEnv -> ExternalUnitCache
ue_eps (HscEnv -> UnitEnv
Development.IDE.GHC.Compat.Env.hsc_unit_env HscEnv
env)) (DynFlags -> InteractiveContext -> SimplifyExprOpts
initSimplifyExprOpts (HscEnv -> DynFlags
hsc_dflags HscEnv
env) (HscEnv -> InteractiveContext
hsc_IC HscEnv
env))
#else
simplifyExpr _ = GHC.simplifyExpr
#endif
corePrepExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr
#if MIN_VERSION_ghc(9,5,0)
corePrepExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr
corePrepExpr DynFlags
_ HscEnv
env CoreExpr
expr = do
CorePrepConfig
cfg <- HscEnv -> IO CorePrepConfig
initCorePrepConfig HscEnv
env
Logger -> CorePrepConfig -> CoreExpr -> IO CoreExpr
GHC.corePrepExpr (HscEnv -> Logger
Development.IDE.GHC.Compat.Env.hsc_logger HscEnv
env) CorePrepConfig
cfg CoreExpr
expr
#else
corePrepExpr _ = GHC.corePrepExpr
#endif
renderMessages :: PsMessages -> (Bag WarnMsg, Bag ErrMsg)
renderMessages :: PsMessages -> (Bag WarnMsg, Bag WarnMsg)
renderMessages PsMessages
msgs =
#if MIN_VERSION_ghc(9,3,0)
let renderMsgs :: (PsMessages -> Messages a) -> Bag WarnMsg
renderMsgs PsMessages -> Messages a
extractor = ((MsgEnvelope a -> WarnMsg) -> Bag (MsgEnvelope a) -> Bag WarnMsg
forall a b. (a -> b) -> Bag a -> Bag b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((MsgEnvelope a -> WarnMsg) -> Bag (MsgEnvelope a) -> Bag WarnMsg)
-> ((a -> DecoratedSDoc) -> MsgEnvelope a -> WarnMsg)
-> (a -> DecoratedSDoc)
-> Bag (MsgEnvelope a)
-> Bag WarnMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> DecoratedSDoc) -> MsgEnvelope a -> WarnMsg
forall a b. (a -> b) -> MsgEnvelope a -> MsgEnvelope b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> DecoratedSDoc
forall a. Diagnostic a => a -> DecoratedSDoc
renderDiagnosticMessageWithHints (Bag (MsgEnvelope a) -> Bag WarnMsg)
-> (Messages a -> Bag (MsgEnvelope a)) -> Messages a -> Bag WarnMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Messages a -> Bag (MsgEnvelope a)
forall e. Messages e -> Bag (MsgEnvelope e)
getMessages (Messages a -> Bag WarnMsg) -> Messages a -> Bag WarnMsg
forall a b. (a -> b) -> a -> b
$ PsMessages -> Messages a
extractor PsMessages
msgs
in ((PsMessages -> Messages PsWarning) -> Bag WarnMsg
forall {a}.
Diagnostic a =>
(PsMessages -> Messages a) -> Bag WarnMsg
renderMsgs PsMessages -> Messages PsWarning
psWarnings, (PsMessages -> Messages PsWarning) -> Bag WarnMsg
forall {a}.
Diagnostic a =>
(PsMessages -> Messages a) -> Bag WarnMsg
renderMsgs PsMessages -> Messages PsWarning
psErrors)
#else
msgs
#endif
pattern PFailedWithErrorMessages :: forall a b. (b -> Bag (MsgEnvelope DecoratedSDoc)) -> ParseResult a
pattern $mPFailedWithErrorMessages :: forall {r} {a} {b}.
ParseResult a -> ((b -> Bag WarnMsg) -> 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
{-# COMPLETE POk, PFailedWithErrorMessages #-}
hieExportNames :: HieFile -> [(SrcSpan, Name)]
hieExportNames :: HieFile -> [(SrcSpan, Name)]
hieExportNames = [AvailInfo] -> [(SrcSpan, Name)]
nameListFromAvails ([AvailInfo] -> [(SrcSpan, Name)])
-> (HieFile -> [AvailInfo]) -> HieFile -> [(SrcSpan, Name)]
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 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]
-> 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 (ModLocation -> Maybe String) -> ModLocation -> Maybe String
forall a b. (a -> b) -> a -> b
$ ModSummary -> ModLocation
ms_location ModSummary
ms
(HieASTs Int
asts',Array Int HieTypeFlat
arr) = HieASTs Mult -> (HieASTs Int, Array Int HieTypeFlat)
compressTypes HieASTs Mult
asts
HieFile -> Hsc HieFile
forall a. a -> Hsc a
forall (m :: * -> *) a. Monad m => a -> m a
return (HieFile -> Hsc HieFile) -> HieFile -> Hsc HieFile
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 Int HieTypeFlat
hie_types = Array Int HieTypeFlat
arr
, hie_asts :: HieASTs Int
hie_asts = HieASTs Int
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 = f $ includePaths x}
where f :: IncludeSpecs -> IncludeSpecs
f IncludeSpecs
i = IncludeSpecs
i{includePathsQuote = path : includePathsQuote i}
setHieDir :: FilePath -> DynFlags -> DynFlags
setHieDir :: String -> DynFlags -> DynFlags
setHieDir String
_f DynFlags
d = DynFlags
d { hieDir = Just _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
= (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_AbstractRefHoleFits
(DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowDocsOfHoleFits
(DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowMatchesOfHoleFits
(DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowProvOfHoleFits
(DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowTypeAppOfHoleFits
(DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowTypeAppVarsOfHoleFits
(DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowTypeOfHoleFits
(DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_set GeneralFlag
Opt_SortBySubsumHoleFits
(DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_SortValidHoleFits
(DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_UnclutterValidHoleFits
(DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ DynFlags
df
{ refLevelHoleFits = refLevelHoleFits df <|> Just 1
, maxRefHoleFits = maxRefHoleFits df <|> Just 10
, maxValidHoleFits = maxValidHoleFits df <|> Just 10
}
nameListFromAvails :: [Avail.AvailInfo] -> [(SrcSpan, Name)]
nameListFromAvails :: [AvailInfo] -> [(SrcSpan, Name)]
nameListFromAvails [AvailInfo]
as =
(Name -> (SrcSpan, Name)) -> [Name] -> [(SrcSpan, Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
n -> (Name -> SrcSpan
nameSrcSpan Name
n, Name
n)) ((AvailInfo -> [Name]) -> [AvailInfo] -> [Name]
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 (ModIfaceBackend -> Fingerprint)
-> (ModIface -> ModIfaceBackend) -> ModIface -> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModIface -> IfaceBackendExts 'ModIfaceFinal
ModIface -> ModIfaceBackend
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts
disableWarningsAsErrors :: DynFlags -> DynFlags
disableWarningsAsErrors :: DynFlags -> DynFlags
disableWarningsAsErrors DynFlags
df =
(DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_WarnIsError (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$! (DynFlags -> WarningFlag -> DynFlags)
-> DynFlags -> [WarningFlag] -> DynFlags
forall b a. (b -> a -> b) -> 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 [Int -> WarningFlag
forall a. Enum a => Int -> a
toEnum Int
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
getSourceNodeIds :: HieAST a -> Map.Map Identifier (IdentifierDetails a)
getSourceNodeIds :: forall a. HieAST a -> Map Identifier (IdentifierDetails a)
getSourceNodeIds = (Map Identifier (IdentifierDetails a)
-> NodeInfo a -> Map Identifier (IdentifierDetails a))
-> Map Identifier (IdentifierDetails a)
-> Map NodeOrigin (NodeInfo a)
-> Map Identifier (IdentifierDetails a)
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' Map Identifier (IdentifierDetails a)
-> NodeInfo a -> Map Identifier (IdentifierDetails a)
forall a.
Map Identifier (IdentifierDetails a)
-> NodeInfo a -> Map Identifier (IdentifierDetails a)
combineNodeIds Map Identifier (IdentifierDetails a)
forall k a. Map k a
Map.empty (Map NodeOrigin (NodeInfo a)
-> Map Identifier (IdentifierDetails a))
-> (HieAST a -> Map NodeOrigin (NodeInfo a))
-> HieAST a
-> Map Identifier (IdentifierDetails a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeOrigin -> NodeInfo a -> Bool)
-> Map NodeOrigin (NodeInfo a) -> Map NodeOrigin (NodeInfo a)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\NodeOrigin
k NodeInfo a
_ -> NodeOrigin
k NodeOrigin -> NodeOrigin -> Bool
forall a. Eq a => a -> a -> Bool
== NodeOrigin
SourceInfo) (Map NodeOrigin (NodeInfo a) -> Map NodeOrigin (NodeInfo a))
-> (HieAST a -> Map NodeOrigin (NodeInfo a))
-> HieAST a
-> Map NodeOrigin (NodeInfo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo (SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a))
-> (HieAST a -> SourcedNodeInfo a)
-> HieAST a
-> Map NodeOrigin (NodeInfo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> SourcedNodeInfo a
forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo
getNodeIds :: HieAST a -> Map.Map Identifier (IdentifierDetails a)
getNodeIds :: forall a. HieAST a -> Map Identifier (IdentifierDetails a)
getNodeIds = (Map Identifier (IdentifierDetails a)
-> NodeInfo a -> Map Identifier (IdentifierDetails a))
-> Map Identifier (IdentifierDetails a)
-> Map NodeOrigin (NodeInfo a)
-> Map Identifier (IdentifierDetails a)
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' Map Identifier (IdentifierDetails a)
-> NodeInfo a -> Map Identifier (IdentifierDetails a)
forall a.
Map Identifier (IdentifierDetails a)
-> NodeInfo a -> Map Identifier (IdentifierDetails a)
combineNodeIds Map Identifier (IdentifierDetails a)
forall k a. Map k a
Map.empty (Map NodeOrigin (NodeInfo a)
-> Map Identifier (IdentifierDetails a))
-> (HieAST a -> Map NodeOrigin (NodeInfo a))
-> HieAST a
-> Map Identifier (IdentifierDetails a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo (SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a))
-> (HieAST a -> SourcedNodeInfo a)
-> HieAST a
-> Map NodeOrigin (NodeInfo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> SourcedNodeInfo a
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) = (IdentifierDetails a -> IdentifierDetails a -> IdentifierDetails a)
-> Map Identifier (IdentifierDetails a)
-> Map Identifier (IdentifierDetails a)
-> Map Identifier (IdentifierDetails a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith IdentifierDetails a -> IdentifierDetails a -> IdentifierDetails a
forall a. Semigroup a => a -> a -> a
(<>) Map Identifier (IdentifierDetails a)
ad Map Identifier (IdentifierDetails a)
bd
nodeInfo' :: HieAST TypeIndex -> NodeInfo TypeIndex
nodeInfo' :: HieAST Int -> NodeInfo Int
nodeInfo' = (NodeInfo Int -> NodeInfo Int -> NodeInfo Int)
-> NodeInfo Int -> Map NodeOrigin (NodeInfo Int) -> NodeInfo Int
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' NodeInfo Int -> NodeInfo Int -> NodeInfo Int
forall a. Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a
combineNodeInfo' NodeInfo Int
forall a. NodeInfo a
emptyNodeInfo (Map NodeOrigin (NodeInfo Int) -> NodeInfo Int)
-> (HieAST Int -> Map NodeOrigin (NodeInfo Int))
-> HieAST Int
-> NodeInfo Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcedNodeInfo Int -> Map NodeOrigin (NodeInfo Int)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo (SourcedNodeInfo Int -> Map NodeOrigin (NodeInfo Int))
-> (HieAST Int -> SourcedNodeInfo Int)
-> HieAST Int
-> Map NodeOrigin (NodeInfo Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST Int -> SourcedNodeInfo Int
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) =
Set NodeAnnotation -> [a] -> NodeIdentifiers a -> NodeInfo a
forall a.
Set NodeAnnotation -> [a] -> NodeIdentifiers a -> NodeInfo a
NodeInfo (Set NodeAnnotation -> Set NodeAnnotation -> Set NodeAnnotation
forall a. Ord a => Set a -> Set a -> Set a
S.union Set NodeAnnotation
as Set NodeAnnotation
bs) ([a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
ai [a]
bi) ((IdentifierDetails a -> IdentifierDetails a -> IdentifierDetails a)
-> NodeIdentifiers a -> NodeIdentifiers a -> NodeIdentifiers a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith IdentifierDetails a -> IdentifierDetails a -> IdentifierDetails a
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]
axs) lb :: [a]
lb@(a
b:[a]
bxs) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b of
Ordering
LT -> a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
axs [a]
lb
Ordering
EQ -> a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
axs [a]
bxs
Ordering
GT -> a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
la [a]
bxs
mergeSorted [a]
axs [] = [a]
axs
mergeSorted [] [a]
bxs = [a]
bxs
sourceNodeInfo :: HieAST a -> Maybe (NodeInfo a)
sourceNodeInfo :: forall a. HieAST a -> Maybe (NodeInfo a)
sourceNodeInfo = NodeOrigin -> Map NodeOrigin (NodeInfo a) -> Maybe (NodeInfo a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NodeOrigin
SourceInfo (Map NodeOrigin (NodeInfo a) -> Maybe (NodeInfo a))
-> (HieAST a -> Map NodeOrigin (NodeInfo a))
-> HieAST a
-> Maybe (NodeInfo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo (SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a))
-> (HieAST a -> SourcedNodeInfo a)
-> HieAST a
-> Map NodeOrigin (NodeInfo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> SourcedNodeInfo a
forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo
generatedNodeInfo :: HieAST a -> Maybe (NodeInfo a)
generatedNodeInfo :: forall a. HieAST a -> Maybe (NodeInfo a)
generatedNodeInfo = NodeOrigin -> Map NodeOrigin (NodeInfo a) -> Maybe (NodeInfo a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NodeOrigin
GeneratedInfo (Map NodeOrigin (NodeInfo a) -> Maybe (NodeInfo a))
-> (HieAST a -> Map NodeOrigin (NodeInfo a))
-> HieAST a
-> Maybe (NodeInfo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo (SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a))
-> (HieAST a -> SourcedNodeInfo a)
-> HieAST a
-> Map NodeOrigin (NodeInfo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> SourcedNodeInfo a
forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo
data GhcVersion
= GHC92
| GHC94
| GHC96
| GHC98
| GHC910
deriving (GhcVersion -> GhcVersion -> Bool
(GhcVersion -> GhcVersion -> Bool)
-> (GhcVersion -> GhcVersion -> Bool) -> Eq GhcVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GhcVersion -> GhcVersion -> Bool
== :: GhcVersion -> GhcVersion -> Bool
$c/= :: GhcVersion -> GhcVersion -> Bool
/= :: GhcVersion -> GhcVersion -> Bool
Eq, Eq GhcVersion
Eq GhcVersion =>
(GhcVersion -> GhcVersion -> Ordering)
-> (GhcVersion -> GhcVersion -> Bool)
-> (GhcVersion -> GhcVersion -> Bool)
-> (GhcVersion -> GhcVersion -> Bool)
-> (GhcVersion -> GhcVersion -> Bool)
-> (GhcVersion -> GhcVersion -> GhcVersion)
-> (GhcVersion -> GhcVersion -> GhcVersion)
-> Ord 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
$ccompare :: GhcVersion -> GhcVersion -> Ordering
compare :: GhcVersion -> GhcVersion -> Ordering
$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
>= :: GhcVersion -> GhcVersion -> Bool
$cmax :: GhcVersion -> GhcVersion -> GhcVersion
max :: GhcVersion -> GhcVersion -> GhcVersion
$cmin :: GhcVersion -> GhcVersion -> GhcVersion
min :: GhcVersion -> GhcVersion -> GhcVersion
Ord, Int -> GhcVersion -> ShowS
[GhcVersion] -> ShowS
GhcVersion -> String
(Int -> GhcVersion -> ShowS)
-> (GhcVersion -> String)
-> ([GhcVersion] -> ShowS)
-> Show GhcVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GhcVersion -> ShowS
showsPrec :: Int -> GhcVersion -> ShowS
$cshow :: GhcVersion -> String
show :: GhcVersion -> String
$cshowList :: [GhcVersion] -> ShowS
showList :: [GhcVersion] -> ShowS
Show, Int -> GhcVersion
GhcVersion -> Int
GhcVersion -> [GhcVersion]
GhcVersion -> GhcVersion
GhcVersion -> GhcVersion -> [GhcVersion]
GhcVersion -> GhcVersion -> GhcVersion -> [GhcVersion]
(GhcVersion -> GhcVersion)
-> (GhcVersion -> GhcVersion)
-> (Int -> GhcVersion)
-> (GhcVersion -> Int)
-> (GhcVersion -> [GhcVersion])
-> (GhcVersion -> GhcVersion -> [GhcVersion])
-> (GhcVersion -> GhcVersion -> [GhcVersion])
-> (GhcVersion -> GhcVersion -> GhcVersion -> [GhcVersion])
-> Enum GhcVersion
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: GhcVersion -> GhcVersion
succ :: GhcVersion -> GhcVersion
$cpred :: GhcVersion -> GhcVersion
pred :: GhcVersion -> GhcVersion
$ctoEnum :: Int -> GhcVersion
toEnum :: Int -> GhcVersion
$cfromEnum :: GhcVersion -> Int
fromEnum :: GhcVersion -> Int
$cenumFrom :: GhcVersion -> [GhcVersion]
enumFrom :: GhcVersion -> [GhcVersion]
$cenumFromThen :: GhcVersion -> GhcVersion -> [GhcVersion]
enumFromThen :: GhcVersion -> GhcVersion -> [GhcVersion]
$cenumFromTo :: GhcVersion -> GhcVersion -> [GhcVersion]
enumFromTo :: GhcVersion -> GhcVersion -> [GhcVersion]
$cenumFromThenTo :: GhcVersion -> GhcVersion -> GhcVersion -> [GhcVersion]
enumFromThenTo :: GhcVersion -> GhcVersion -> GhcVersion -> [GhcVersion]
Enum)
ghcVersionStr :: String
ghcVersionStr :: String
ghcVersionStr = VERSION_ghc
ghcVersion :: GhcVersion
#if MIN_VERSION_GLASGOW_HASKELL(9,10,0,0)
ghcVersion = GHC910
#elif MIN_VERSION_GLASGOW_HASKELL(9,8,0,0)
ghcVersion = GHC98
#elif MIN_VERSION_GLASGOW_HASKELL(9,6,0,0)
ghcVersion :: GhcVersion
ghcVersion = GhcVersion
GHC96
#elif MIN_VERSION_GLASGOW_HASKELL(9,4,0,0)
ghcVersion = GHC94
#elif MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)
ghcVersion = GHC92
#endif
simpleNodeInfoCompat :: FastStringCompat -> FastStringCompat -> NodeInfo a
simpleNodeInfoCompat :: forall a. FastStringCompat -> FastStringCompat -> NodeInfo a
simpleNodeInfoCompat FastStringCompat
ctor FastStringCompat
typ = FastString -> FastString -> NodeInfo a
forall a. FastString -> FastString -> NodeInfo a
simpleNodeInfo (FastStringCompat -> FastString
forall a b. Coercible a b => a -> b
coerce FastStringCompat
ctor) (FastStringCompat -> FastString
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 = (FastStringCompat, FastStringCompat)
-> Set (FastStringCompat, FastStringCompat) -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member (FastStringCompat, FastStringCompat)
p (Set (FastStringCompat, FastStringCompat) -> Bool)
-> (NodeInfo a -> Set (FastStringCompat, FastStringCompat))
-> NodeInfo a
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo a -> Set (FastStringCompat, FastStringCompat)
forall a. NodeInfo a -> Set (FastStringCompat, FastStringCompat)
nodeAnnotations
nodeAnnotations :: NodeInfo a -> S.Set (FastStringCompat, FastStringCompat)
nodeAnnotations :: forall a. NodeInfo a -> Set (FastStringCompat, FastStringCompat)
nodeAnnotations = (NodeAnnotation -> (FastStringCompat, FastStringCompat))
-> Set NodeAnnotation -> Set (FastStringCompat, FastStringCompat)
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (\(NodeAnnotation FastString
ctor FastString
typ) -> (FastString -> FastStringCompat
forall a b. Coercible a b => a -> b
coerce FastString
ctor, FastString -> FastStringCompat
forall a b. Coercible a b => a -> b
coerce FastString
typ)) (Set NodeAnnotation -> Set (FastStringCompat, FastStringCompat))
-> (NodeInfo a -> Set NodeAnnotation)
-> NodeInfo a
-> Set (FastStringCompat, FastStringCompat)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo a -> Set NodeAnnotation
forall a. NodeInfo a -> Set NodeAnnotation
GHC.nodeAnnotations
newtype FastStringCompat = FastStringCompat LexicalFastString
deriving (Int -> FastStringCompat -> ShowS
[FastStringCompat] -> ShowS
FastStringCompat -> String
(Int -> FastStringCompat -> ShowS)
-> (FastStringCompat -> String)
-> ([FastStringCompat] -> ShowS)
-> Show FastStringCompat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FastStringCompat -> ShowS
showsPrec :: Int -> FastStringCompat -> ShowS
$cshow :: FastStringCompat -> String
show :: FastStringCompat -> String
$cshowList :: [FastStringCompat] -> ShowS
showList :: [FastStringCompat] -> ShowS
Show, FastStringCompat -> FastStringCompat -> Bool
(FastStringCompat -> FastStringCompat -> Bool)
-> (FastStringCompat -> FastStringCompat -> Bool)
-> Eq FastStringCompat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FastStringCompat -> FastStringCompat -> Bool
== :: FastStringCompat -> FastStringCompat -> Bool
$c/= :: FastStringCompat -> FastStringCompat -> Bool
/= :: FastStringCompat -> FastStringCompat -> Bool
Eq, Eq FastStringCompat
Eq FastStringCompat =>
(FastStringCompat -> FastStringCompat -> Ordering)
-> (FastStringCompat -> FastStringCompat -> Bool)
-> (FastStringCompat -> FastStringCompat -> Bool)
-> (FastStringCompat -> FastStringCompat -> Bool)
-> (FastStringCompat -> FastStringCompat -> Bool)
-> (FastStringCompat -> FastStringCompat -> FastStringCompat)
-> (FastStringCompat -> FastStringCompat -> FastStringCompat)
-> Ord 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
$ccompare :: FastStringCompat -> FastStringCompat -> Ordering
compare :: FastStringCompat -> FastStringCompat -> Ordering
$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
>= :: FastStringCompat -> FastStringCompat -> Bool
$cmax :: FastStringCompat -> FastStringCompat -> FastStringCompat
max :: FastStringCompat -> FastStringCompat -> FastStringCompat
$cmin :: FastStringCompat -> FastStringCompat -> FastStringCompat
min :: FastStringCompat -> FastStringCompat -> FastStringCompat
Ord)
instance IsString FastStringCompat where
fromString :: String -> FastStringCompat
fromString = LexicalFastString -> FastStringCompat
FastStringCompat (LexicalFastString -> FastStringCompat)
-> (String -> LexicalFastString) -> String -> FastStringCompat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> LexicalFastString
LexicalFastString (FastString -> LexicalFastString)
-> (String -> FastString) -> String -> LexicalFastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
forall a. IsString a => String -> a
fromString
mkAstNode :: NodeInfo a -> Span -> [HieAST a] -> HieAST a
mkAstNode :: forall a. NodeInfo a -> Span -> [HieAST a] -> HieAST a
mkAstNode NodeInfo a
n = SourcedNodeInfo a -> Span -> [HieAST a] -> HieAST a
forall a. SourcedNodeInfo a -> Span -> [HieAST a] -> HieAST a
Node (Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a
forall a. Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a
SourcedNodeInfo (Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a)
-> Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a
forall a b. (a -> b) -> a -> b
$ NodeOrigin -> NodeInfo a -> Map NodeOrigin (NodeInfo a)
forall k a. k -> a -> Map k a
Map.singleton NodeOrigin
GeneratedInfo NodeInfo a
n)
loadModulesHome
:: [HomeModInfo]
-> HscEnv
-> HscEnv
loadModulesHome :: [HomeModInfo] -> HscEnv -> HscEnv
loadModulesHome [HomeModInfo]
mod_infos HscEnv
e =
#if MIN_VERSION_ghc(9,3,0)
(HomeUnitGraph -> HomeUnitGraph) -> HscEnv -> HscEnv
hscUpdateHUG (\HomeUnitGraph
hug -> (HomeUnitGraph -> HomeModInfo -> HomeUnitGraph)
-> HomeUnitGraph -> [HomeModInfo] -> HomeUnitGraph
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((HomeModInfo -> HomeUnitGraph -> HomeUnitGraph)
-> HomeUnitGraph -> HomeModInfo -> HomeUnitGraph
forall a b c. (a -> b -> c) -> b -> a -> c
flip HomeModInfo -> HomeUnitGraph -> HomeUnitGraph
addHomeModInfoToHug) HomeUnitGraph
hug [HomeModInfo]
mod_infos) (HscEnv
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 :: forall (p :: Pass) arg. HsRecFields (GhcPass p) arg -> Maybe Int
recDotDot HsRecFields (GhcPass p) arg
x =
#if MIN_VERSION_ghc(9,5,0)
RecFieldsDotDot -> Int
unRecFieldsDotDot (RecFieldsDotDot -> Int)
-> (GenLocated SrcSpan RecFieldsDotDot -> RecFieldsDotDot)
-> GenLocated SrcSpan RecFieldsDotDot
-> Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
#endif
GenLocated SrcSpan RecFieldsDotDot -> RecFieldsDotDot
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan RecFieldsDotDot -> Int)
-> Maybe (GenLocated SrcSpan RecFieldsDotDot) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsRecFields (GhcPass p) arg
-> Maybe (XRec (GhcPass p) RecFieldsDotDot)
forall p arg. HsRecFields p arg -> Maybe (XRec p RecFieldsDotDot)
rec_dotdot HsRecFields (GhcPass p) arg
x
#if MIN_VERSION_ghc(9,5,0)
(NewTypeCon a
x) = [a
x]
extract_cons (DataTypeCons Bool
_ [a]
xs) = [a]
xs
#else
extract_cons = id
#endif