{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternSynonyms #-}
module Development.IDE.GHC.Compat.Core (
DynFlags,
extensions,
extensionFlags,
targetPlatform,
packageFlags,
generalFlags,
warningFlags,
topDir,
hiDir,
tmpDir,
importPaths,
useColor,
canUseColor,
useUnicode,
objectDir,
flagsForCompletion,
setImportPaths,
outputFile,
pluginModNames,
refLevelHoleFits,
maxRefHoleFits,
maxValidHoleFits,
setOutputFile,
lookupType,
needWiredInHomeIface,
loadWiredInHomeIface,
readIface,
loadSysInterface,
importDecl,
CommandLineOption,
sPgm_F,
settings,
gopt,
gopt_set,
gopt_unset,
wopt,
wopt_set,
xFlags,
xopt,
xopt_unset,
xopt_set,
FlagSpec(..),
WarningFlag(..),
GeneralFlag(..),
PackageFlag,
PackageArg(..),
ModRenaming(..),
pattern ExposePackage,
parseDynamicFlagsCmdLine,
parseDynamicFilePragma,
#if !MIN_VERSION_ghc(9,3,0)
WarnReason(..),
#endif
wWarningFlags,
updOptLevel,
setUnsafeGlobalDynFlags,
scaledThing,
IfaceExport,
IfaceTyCon(..),
ModIface,
ModIface_(..),
HscSource(..),
WhereFrom(..),
loadInterface,
#if !MIN_VERSION_ghc(9,3,0)
SourceModified(..),
#endif
loadModuleInterface,
RecompileRequired(..),
mkPartialIface,
mkFullIface,
IsBootInterface(..),
LexicalFixity(..),
Fixity (..),
mi_fix,
defaultFixity,
lookupFixityRn,
ModSummary(..),
HomeModInfo(..),
ModGuts(..),
CgGuts(..),
ModDetails(..),
Type (
TyCoRep.TyVarTy,
TyCoRep.AppTy,
TyCoRep.TyConApp,
TyCoRep.ForAllTy,
TyCoRep.LitTy,
TyCoRep.CastTy,
TyCoRep.CoercionTy
),
pattern FunTy,
pattern ConPatIn,
conPatDetails,
mapConPatDetail,
ImpDeclSpec(..),
ImportSpec(..),
SourceText(..),
Way,
wayGeneralFlags,
wayUnsetGeneralFlags,
Avail.AvailInfo,
pattern AvailName,
pattern AvailFL,
pattern AvailTC,
Avail.availName,
Avail.availNames,
#if !MIN_VERSION_ghc(9,7,0)
Avail.availNamesWithSelectors,
#endif
Avail.availsToNameSet,
TcGblEnv(..),
HsModule(..),
GHC.ParsedSource,
GHC.RenamedSource,
HscEnv,
GHC.runGhc,
unGhc,
Session(..),
modifySession,
getSession,
GHC.setSessionDynFlags,
getSessionDynFlags,
GhcMonad,
Ghc,
runHsc,
compileFile,
Phase(..),
hscDesugar,
hscGenHardCode,
hscInteractive,
hscSimplify,
hscTypecheckRename,
hscUpdateHPT,
Development.IDE.GHC.Compat.Core.makeSimpleDetails,
tcSplitForAllTyVars,
tcSplitForAllTyVarBinder_maybe,
typecheckIface,
Development.IDE.GHC.Compat.Core.mkIfaceTc,
Development.IDE.GHC.Compat.Core.mkBootModDetailsTc,
Development.IDE.GHC.Compat.Core.initTidyOpts,
driverNoStop,
tidyProgram,
ImportedModsVal(..),
importedByUser,
GHC.TypecheckedSource,
HasSrcSpan,
SrcLoc.Located,
SrcLoc.unLoc,
getLoc,
GHC.getLocA,
GHC.locA,
GHC.noLocA,
unLocA,
LocatedAn,
GHC.LocatedA,
GHC.AnnListItem(..),
GHC.NameAnn(..),
SrcLoc.RealLocated,
SrcLoc.GenLocated(..),
SrcLoc.SrcSpan(SrcLoc.UnhelpfulSpan),
SrcLoc.RealSrcSpan,
pattern RealSrcSpan,
SrcLoc.RealSrcLoc,
pattern RealSrcLoc,
SrcLoc.SrcLoc(SrcLoc.UnhelpfulLoc),
BufSpan,
#if !MIN_VERSION_ghc(9,9,0)
GHC.SrcAnn,
#endif
SrcLoc.leftmost_smallest,
SrcLoc.containsSpan,
SrcLoc.mkGeneralSrcSpan,
SrcLoc.mkRealSrcSpan,
SrcLoc.mkRealSrcLoc,
SrcLoc.getRealSrcSpan,
SrcLoc.realSrcLocSpan,
SrcLoc.realSrcSpanStart,
SrcLoc.realSrcSpanEnd,
isSubspanOfA,
SrcLoc.isSubspanOf,
SrcLoc.wiredInSrcSpan,
SrcLoc.mkSrcSpan,
SrcLoc.srcSpanStart,
SrcLoc.srcSpanStartLine,
SrcLoc.srcSpanStartCol,
SrcLoc.srcSpanEnd,
SrcLoc.srcSpanEndLine,
SrcLoc.srcSpanEndCol,
SrcLoc.srcSpanFile,
SrcLoc.srcLocCol,
SrcLoc.srcLocFile,
SrcLoc.srcLocLine,
SrcLoc.noSrcSpan,
SrcLoc.noSrcLoc,
SrcLoc.noLoc,
mapLoc,
FindResult(..),
mkHomeModLocation,
findObjectLinkableMaybe,
InstalledFindResult(..),
ModuleOrigin(..),
PackageName(..),
Unlinked(..),
Linkable(..),
unload,
Hooks,
runMetaHook,
MetaHook,
MetaRequest(..),
metaRequestE,
metaRequestP,
metaRequestT,
metaRequestD,
metaRequestAW,
addToHpt,
addListToHpt,
Target(..),
TargetId(..),
mkSimpleTarget,
initObjLinker,
loadDLL,
InteractiveImport(..),
GHC.getContext,
GHC.setContext,
GHC.parseImportDecl,
GHC.runDecls,
Warn(..),
GHC.ModLocation,
Module.ml_hs_file,
Module.ml_obj_file,
Module.ml_hi_file,
Module.ml_hie_file,
DataCon.dataConExTyCoVars,
Role(..),
Plain.PlainGhcException,
GHC.CoreModule(..),
GHC.SafeHaskellMode(..),
pattern GRE,
gre_name,
gre_imp,
gre_lcl,
gre_par,
collectHsBindsBinders,
module GHC.Builtin.Names,
module GHC.Builtin.Types,
module GHC.Builtin.Types.Prim,
module GHC.Builtin.Utils,
module GHC.Core.Class,
module GHC.Core.Coercion,
module GHC.Core.ConLike,
module GHC.Core.DataCon,
module GHC.Core.FamInstEnv,
module GHC.Core.InstEnv,
module GHC.Types.Unique.FM,
module GHC.Core.PatSyn,
module GHC.Core.Predicate,
module GHC.Core.TyCon,
module GHC.Core.TyCo.Ppr,
module GHC.Core.Type,
module GHC.Core.Unify,
module GHC.Core.Utils,
module GHC.HsToCore.Docs,
module GHC.HsToCore.Expr,
module GHC.HsToCore.Monad,
module GHC.Iface.Syntax,
module GHC.Iface.Recomp,
module GHC.Hs.Decls,
module GHC.Hs.Expr,
module GHC.Hs.Doc,
module GHC.Hs.Extension,
module GHC.Hs.ImpExp,
module GHC.Hs.Pat,
module GHC.Hs.Type,
module GHC.Hs.Utils,
module Language.Haskell.Syntax,
module GHC.Rename.Names,
module GHC.Rename.Splice,
module GHC.Tc.Instance.Family,
module GHC.Tc.Module,
module GHC.Tc.Types,
module GHC.Tc.Types.Evidence,
module GHC.Tc.Utils.Env,
module GHC.Tc.Utils.Monad,
module GHC.Types.Basic,
module GHC.Types.Id,
module GHC.Types.Name,
module GHC.Types.Name.Set,
module GHC.Types.Name.Cache,
module GHC.Types.Name.Env,
module GHC.Types.Name.Reader,
module GHC.Utils.Error,
#if !MIN_VERSION_ghc(9,7,0)
module GHC.Types.Avail,
#endif
module GHC.Types.SourceFile,
module GHC.Types.SourceText,
module GHC.Types.TyThing,
module GHC.Types.TyThing.Ppr,
module GHC.Types.Unique.Supply,
module GHC.Types.Var,
module GHC.Unit.Module,
module GHC.Unit.Module.Graph,
module GHC.Hs,
module GHC.Hs.Binds,
module GHC.Parser,
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,
GhcMessage(..),
getKey,
module GHC.Driver.Env.KnotVars,
module GHC.Linker.Types,
module GHC.Types.Unique.Map,
module GHC.Utils.TmpFs,
module GHC.Unit.Finder.Types,
module GHC.Unit.Env,
module GHC.Driver.Phases,
#endif
#if !MIN_VERSION_ghc(9,4,0)
pattern HsFieldBind,
hfbAnn,
hfbLHS,
hfbRHS,
hfbPun,
#endif
#if !MIN_VERSION_ghc_boot_th(9,4,1)
Extension(.., NamedFieldPuns),
#else
Extension(..),
#endif
mkCgInteractiveGuts,
justBytecode,
justObjects,
emptyHomeModInfoLinkable,
homeModInfoByteCode,
homeModInfoObject,
#if !MIN_VERSION_ghc(9,5,0)
field_label,
#endif
groupOrigin,
isVisibleFunArg,
#if MIN_VERSION_ghc(9,8,0)
lookupGlobalRdrEnv
#endif
) where
import qualified GHC
import GHC.LanguageExtensions.Type hiding (Cpp)
import GHC.Builtin.Names hiding (Unique, printName)
import GHC.Builtin.Types
import GHC.Builtin.Types.Prim
import GHC.Builtin.Utils
import GHC.Core (CoreProgram)
import GHC.Core.Class
import GHC.Core.Coercion
import GHC.Core.ConLike
import GHC.Core.DataCon hiding (dataConExTyCoVars)
import qualified GHC.Core.DataCon as DataCon
import GHC.Core.FamInstEnv hiding (pprFamInst)
import GHC.Core.InstEnv
import GHC.Core.PatSyn
import GHC.Core.Predicate
import GHC.Core.TyCo.Ppr
import qualified GHC.Core.TyCo.Rep as TyCoRep
import GHC.Core.TyCon
import GHC.Core.Type
import GHC.Core.Unify
import GHC.Core.Utils
import GHC.Driver.CmdLine (Warn (..))
import GHC.Driver.Hooks
import GHC.Driver.Main as GHC
import GHC.Driver.Monad
import GHC.Driver.Phases
import GHC.Driver.Pipeline
import GHC.Driver.Plugins
import GHC.Driver.Session hiding (ExposePackage)
import qualified GHC.Driver.Session as DynFlags
import GHC.Hs.Binds
import GHC.HsToCore.Docs
import GHC.HsToCore.Expr
import GHC.HsToCore.Monad
import GHC.Iface.Load
import GHC.Iface.Make as GHC
import GHC.Iface.Recomp
import GHC.Iface.Syntax
import GHC.Iface.Tidy as GHC
import GHC.IfaceToCore
import GHC.Parser
import GHC.Parser.Header hiding (getImports)
import GHC.Rename.Fixity (lookupFixityRn)
import GHC.Rename.Names
import GHC.Rename.Splice
import qualified GHC.Runtime.Interpreter as GHCi
import GHC.Tc.Instance.Family
import GHC.Tc.Module
import GHC.Tc.Types
import GHC.Tc.Types.Evidence hiding ((<.>))
import GHC.Tc.Utils.Env
import GHC.Tc.Utils.Monad hiding (Applicative (..), IORef,
MonadFix (..), MonadIO (..), allM,
anyM, concatMapM, mapMaybeM,
(<$>))
import GHC.Tc.Utils.TcType as TcType
import qualified GHC.Types.Avail as Avail
import GHC.Types.Basic
import GHC.Types.Id
import GHC.Types.Name hiding (varName)
import GHC.Types.Name.Cache
import GHC.Types.Name.Env
import GHC.Types.Name.Reader hiding (GRE, gre_imp, gre_lcl,
gre_name, gre_par)
import qualified GHC.Types.Name.Reader as RdrName
import GHC.Types.SrcLoc (BufPos, BufSpan,
SrcLoc (UnhelpfulLoc),
SrcSpan (UnhelpfulSpan))
import qualified GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Unique.FM
import GHC.Types.Unique.Supply
import GHC.Types.Var (Var (varName), setTyVarUnique,
setVarUnique)
import qualified GHC.Types.Var as TypesVar
import GHC.Unit.Info (PackageName (..))
import GHC.Unit.Module hiding (ModLocation (..), UnitId,
moduleUnit, toUnitId)
import qualified GHC.Unit.Module as Module
import GHC.Unit.State (ModuleOrigin (..))
import GHC.Utils.Error (Severity (..), emptyMessages)
import GHC.Utils.Panic hiding (try)
import qualified GHC.Utils.Panic.Plain as Plain
import Data.Foldable (toList)
import GHC.Core.Multiplicity (scaledThing)
import GHC.Data.Bag
import GHC.Driver.Env
import GHC.Hs (HsModule (..))
#if !MIN_VERSION_ghc(9,9,0)
import GHC.Hs (SrcSpanAnn')
#endif
import GHC.Hs.Decls hiding (FunDep)
import GHC.Hs.Doc
import GHC.Hs.Expr
import GHC.Hs.Extension
import GHC.Hs.ImpExp
import GHC.Hs.Pat
import GHC.Hs.Type
import GHC.Hs.Utils hiding (collectHsBindsBinders)
import qualified GHC.Linker.Loader as Linker
import GHC.Linker.Types
import GHC.Parser.Annotation (EpAnn (..))
import GHC.Parser.Lexer hiding (getPsMessages,
initParserState)
import GHC.Platform.Ways
import GHC.Runtime.Context (InteractiveImport (..))
import GHC.Types.Fixity (Fixity (..), LexicalFixity (..),
defaultFixity)
import GHC.Types.Meta
import GHC.Types.Name.Set
import GHC.Types.SourceFile (HscSource (..))
import GHC.Types.SourceText
import GHC.Types.Target (Target (..), TargetId (..))
import GHC.Types.TyThing
import GHC.Types.TyThing.Ppr
import GHC.Unit.Finder hiding (mkHomeModLocation)
import GHC.Unit.Home.ModInfo
import GHC.Unit.Module.Imported
import GHC.Unit.Module.ModDetails
import GHC.Unit.Module.ModGuts
import GHC.Unit.Module.ModIface (IfaceExport, ModIface,
ModIface_ (..), mi_fix)
import GHC.Unit.Module.ModSummary (ModSummary (..))
import Language.Haskell.Syntax hiding (FunDep)
#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
import GHC.Driver.Env as GHCi
import GHC.Driver.Env.KnotVars
import GHC.Driver.Errors.Types
import GHC.Types.Unique
import GHC.Types.Unique.Map
import GHC.Unit.Env
import qualified GHC.Unit.Finder as GHC
import GHC.Unit.Finder.Types
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 :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
mkHomeModLocation DynFlags
df ModuleName
mn FilePath
f = ModLocation -> IO ModLocation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModLocation -> IO ModLocation) -> ModLocation -> IO ModLocation
forall a b. (a -> b) -> a -> b
$ FinderOpts -> ModuleName -> FilePath -> ModLocation
GHC.mkHomeModLocation (DynFlags -> FinderOpts
GHC.initFinderOpts DynFlags
df) ModuleName
mn FilePath
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 $mRealSrcSpan :: forall {r}.
SrcSpan -> (RealSrcSpan -> Maybe BufSpan -> r) -> ((# #) -> r) -> r
$bRealSrcSpan :: RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan x y <- SrcLoc.RealSrcSpan x ((\case Maybe BufSpan
Strict.Nothing -> Maybe BufSpan
forall a. Maybe a
Nothing; Strict.Just BufSpan
a -> BufSpan -> Maybe BufSpan
forall a. a -> Maybe a
Just BufSpan
a) -> y) where
RealSrcSpan RealSrcSpan
x Maybe BufSpan
y = RealSrcSpan -> Maybe BufSpan -> SrcSpan
SrcLoc.RealSrcSpan RealSrcSpan
x (case Maybe BufSpan
y of Maybe BufSpan
Nothing -> Maybe BufSpan
forall a. Maybe a
Strict.Nothing; Just BufSpan
a -> BufSpan -> Maybe BufSpan
forall a. a -> Maybe a
Strict.Just BufSpan
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 $mRealSrcLoc :: forall {r}.
SrcLoc -> (RealSrcLoc -> Maybe BufPos -> r) -> ((# #) -> r) -> r
$bRealSrcLoc :: RealSrcLoc -> Maybe BufPos -> SrcLoc
RealSrcLoc x y = SrcLoc.RealSrcLoc x y
{-# COMPLETE RealSrcLoc, UnhelpfulLoc #-}
pattern AvailTC :: Name -> [Name] -> [FieldLabel] -> Avail.AvailInfo
#if __GLASGOW_HASKELL__ >= 907
pattern AvailTC n names pieces <- Avail.AvailTC n ((,[]) -> (names,pieces))
#else
pattern $mAvailTC :: forall {r}.
AvailInfo
-> (Name -> [Name] -> [FieldLabel] -> r) -> ((# #) -> r) -> r
AvailTC n names pieces <- Avail.AvailTC n ((\[GreName]
gres -> (GreName -> ([Name], [FieldLabel]) -> ([Name], [FieldLabel]))
-> ([Name], [FieldLabel]) -> [GreName] -> ([Name], [FieldLabel])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\GreName
gre ([Name]
names, [FieldLabel]
pieces) -> case GreName
gre of
Avail.NormalGreName Name
name -> (Name
nameName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
names, [FieldLabel]
pieces)
Avail.FieldGreName FieldLabel
label -> ([Name]
names, FieldLabel
labelFieldLabel -> [FieldLabel] -> [FieldLabel]
forall a. a -> [a] -> [a]
:[FieldLabel]
pieces)) ([], []) [GreName]
gres) -> (names, pieces))
#endif
pattern AvailName :: Name -> Avail.AvailInfo
#if __GLASGOW_HASKELL__ >= 907
pattern AvailName n <- Avail.Avail n
#else
pattern $mAvailName :: forall {r}. AvailInfo -> (Name -> r) -> ((# #) -> r) -> r
AvailName n <- Avail.Avail (Avail.NormalGreName n)
#endif
pattern AvailFL :: FieldLabel -> Avail.AvailInfo
#if __GLASGOW_HASKELL__ >= 907
pattern AvailFL fl <- (const Nothing -> Just fl)
#else
pattern $mAvailFL :: forall {r}. AvailInfo -> (FieldLabel -> r) -> ((# #) -> r) -> r
AvailFL fl <- Avail.Avail (Avail.FieldGreName fl)
#endif
{-# COMPLETE AvailTC, AvailName, AvailFL #-}
setImportPaths :: [FilePath] -> DynFlags -> DynFlags
setImportPaths :: [FilePath] -> DynFlags -> DynFlags
setImportPaths [FilePath]
importPaths DynFlags
flags = DynFlags
flags { importPaths = importPaths }
pattern ExposePackage :: String -> PackageArg -> ModRenaming -> PackageFlag
#ifdef __FACEBOOK_HASKELL__
pattern ExposePackage s a mr <- DynFlags.ExposePackage s a _ mr
#else
pattern $mExposePackage :: forall {r}.
PackageFlag
-> (FilePath -> PackageArg -> ModRenaming -> r)
-> ((# #) -> r)
-> r
$bExposePackage :: FilePath -> PackageArg -> ModRenaming -> PackageFlag
ExposePackage s a mr = DynFlags.ExposePackage s a mr
#endif
isVisibleFunArg :: Development.IDE.GHC.Compat.Core.FunTyFlag -> Bool
#if __GLASGOW_HASKELL__ >= 906
isVisibleFunArg :: FunTyFlag -> Bool
isVisibleFunArg = FunTyFlag -> Bool
TypesVar.isVisibleFunArg
type FunTyFlag = TypesVar.FunTyFlag
#else
isVisibleFunArg VisArg = True
isVisibleFunArg _ = False
type FunTyFlag = TypesVar.AnonArgFlag
#endif
pattern FunTy :: Development.IDE.GHC.Compat.Core.FunTyFlag -> Type -> Type -> Type
pattern $mFunTy :: forall {r}.
Type -> (FunTyFlag -> Type -> Type -> r) -> ((# #) -> r) -> r
FunTy af arg res <- TyCoRep.FunTy {ft_af = af, ft_arg = arg, ft_res = res}
class HasSrcSpan a where
getLoc :: a -> SrcSpan
instance HasSrcSpan SrcSpan where
getLoc :: SrcSpan -> SrcSpan
getLoc = SrcSpan -> SrcSpan
forall a. a -> a
id
instance HasSrcSpan (SrcLoc.GenLocated SrcSpan a) where
getLoc :: GenLocated SrcSpan a -> SrcSpan
getLoc = GenLocated SrcSpan a -> SrcSpan
forall l e. GenLocated l e -> l
GHC.getLoc
#if MIN_VERSION_ghc(9,9,0)
instance HasSrcSpan (EpAnn a) where
getLoc = GHC.getHasLoc
#endif
#if MIN_VERSION_ghc(9,9,0)
instance HasSrcSpan (SrcLoc.GenLocated (EpAnn ann) a) where
getLoc (L l _) = getLoc l
#else
instance HasSrcSpan (SrcSpanAnn' ann) where
getLoc :: SrcSpanAnn' ann -> SrcSpan
getLoc = SrcSpanAnn' ann -> SrcSpan
forall ann. SrcSpanAnn' ann -> SrcSpan
GHC.locA
instance HasSrcSpan (SrcLoc.GenLocated (SrcSpanAnn' ann) a) where
getLoc :: GenLocated (SrcSpanAnn' ann) a -> SrcSpan
getLoc (L SrcSpan
l a
_) = SrcSpan
l
#endif
pattern L :: HasSrcSpan a => SrcSpan -> e -> SrcLoc.GenLocated a e
pattern $mL :: forall {r} {a} {e}.
HasSrcSpan a =>
GenLocated a e -> (SrcSpan -> e -> r) -> ((# #) -> r) -> r
L l a <- GHC.L (getLoc -> l) a
{-# COMPLETE L #-}
pattern ConPatIn :: SrcLoc.Located (ConLikeP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
#if MIN_VERSION_ghc(9,9,0)
pattern ConPatIn con args <- ConPat _ (L _ (SrcLoc.noLoc -> con)) args
where
ConPatIn con args = ConPat GHC.noAnn (GHC.noLocA $ SrcLoc.unLoc con) args
#else
pattern $mConPatIn :: forall {r}.
Pat GhcPs
-> (Located (ConLikeP GhcPs) -> HsConPatDetails GhcPs -> r)
-> ((# #) -> r)
-> r
$bConPatIn :: Located (ConLikeP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
ConPatIn con args <- ConPat EpAnnNotUsed (L _ (SrcLoc.noLoc -> con)) args
where
ConPatIn Located (ConLikeP GhcPs)
con HsConPatDetails GhcPs
args = XConPat GhcPs
-> XRec GhcPs (ConLikeP GhcPs)
-> HsConPatDetails GhcPs
-> Pat GhcPs
forall p.
XConPat p -> XRec p (ConLikeP p) -> HsConPatDetails p -> Pat p
ConPat XConPat GhcPs
EpAnn [AddEpAnn]
forall ann. EpAnn ann
EpAnnNotUsed (RdrName -> GenLocated SrcSpanAnnN RdrName
forall a an. a -> LocatedAn an a
GHC.noLocA (RdrName -> GenLocated SrcSpanAnnN RdrName)
-> RdrName -> GenLocated SrcSpanAnnN RdrName
forall a b. (a -> b) -> a -> b
$ Located RdrName -> RdrName
forall l e. GenLocated l e -> e
SrcLoc.unLoc Located RdrName
Located (ConLikeP GhcPs)
con) HsConPatDetails GhcPs
args
#endif
conPatDetails :: Pat p -> Maybe (HsConPatDetails p)
conPatDetails :: forall p. Pat p -> Maybe (HsConPatDetails p)
conPatDetails (ConPat XConPat p
_ XRec p (ConLikeP p)
_ HsConPatDetails p
args) = HsConPatDetails p -> Maybe (HsConPatDetails p)
forall a. a -> Maybe a
Just HsConPatDetails p
args
conPatDetails Pat p
_ = Maybe (HsConPatDetails p)
forall a. Maybe a
Nothing
mapConPatDetail :: (HsConPatDetails p -> Maybe (HsConPatDetails p)) -> Pat p -> Maybe (Pat p)
mapConPatDetail :: forall p.
(HsConPatDetails p -> Maybe (HsConPatDetails p))
-> Pat p -> Maybe (Pat p)
mapConPatDetail HsConPatDetails p -> Maybe (HsConPatDetails p)
f pat :: Pat p
pat@(ConPat XConPat p
_ XRec p (ConLikeP p)
_ HsConPatDetails p
args) = (\HsConPatDetails p
args' -> Pat p
pat { pat_args = args'}) (HsConPatDetails p -> Pat p)
-> Maybe (HsConPatDetails p) -> Maybe (Pat p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsConPatDetails p -> Maybe (HsConPatDetails p)
f HsConPatDetails p
args
mapConPatDetail HsConPatDetails p -> Maybe (HsConPatDetails p)
_ Pat p
_ = Maybe (Pat p)
forall a. Maybe a
Nothing
initObjLinker :: HscEnv -> IO ()
initObjLinker :: HscEnv -> IO ()
initObjLinker HscEnv
env =
Interp -> IO ()
GHCi.initObjLinker (HscEnv -> Interp
GHCi.hscInterp HscEnv
env)
loadDLL :: HscEnv -> String -> IO (Maybe String)
loadDLL :: HscEnv -> FilePath -> IO (Maybe FilePath)
loadDLL HscEnv
env FilePath
str = do
Maybe FilePath
res <- Interp -> FilePath -> IO (Maybe FilePath)
GHCi.loadDLL (HscEnv -> Interp
GHCi.hscInterp HscEnv
env) FilePath
str
#if MIN_VERSION_ghc(9,11,0)
pure $
case res of
Left err_msg -> Just err_msg
Right _ -> Nothing
#else
Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
res
#endif
unload :: HscEnv -> [Linkable] -> IO ()
unload :: HscEnv -> [Linkable] -> IO ()
unload HscEnv
hsc_env [Linkable]
linkables =
Interp -> HscEnv -> [Linkable] -> IO ()
Linker.unload
(HscEnv -> Interp
GHCi.hscInterp HscEnv
hsc_env)
HscEnv
hsc_env [Linkable]
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 :: forall la a lb b. LocatedAn la a -> LocatedAn lb b -> Bool
isSubspanOfA LocatedAn la a
a LocatedAn lb b
b = SrcSpan -> SrcSpan -> Bool
SrcLoc.isSubspanOf (LocatedAn la a -> SrcSpan
forall ann a. GenLocated (SrcSpanAnn' ann) a -> SrcSpan
GHC.getLocA LocatedAn la a
a) (LocatedAn lb b -> SrcSpan
forall ann a. GenLocated (SrcSpanAnn' ann) a -> SrcSpan
GHC.getLocA LocatedAn lb b
b)
type LocatedAn a = GHC.LocatedAn a
unLocA :: forall pass a. XRec (GhcPass pass) a -> a
unLocA :: forall (pass :: Pass) a. XRec (GhcPass pass) a -> a
unLocA = forall p a. UnXRec p => XRec p a -> a
unXRec @(GhcPass pass)
pattern GRE :: Name -> Parent -> Bool -> [ImportSpec] -> RdrName.GlobalRdrElt
{-# COMPLETE GRE #-}
pattern $mGRE :: forall {r}.
GlobalRdrElt
-> (Name -> Parent -> Bool -> [ImportSpec] -> r)
-> ((# #) -> r)
-> r
GRE{GlobalRdrElt -> Name
gre_name, GlobalRdrElt -> Parent
gre_par, GlobalRdrElt -> Bool
gre_lcl, GlobalRdrElt -> [ImportSpec]
gre_imp} <- RdrName.GRE
#if MIN_VERSION_ghc(9,7,0)
{gre_name = gre_name
#else
{gre_name = (greNamePrintableName -> gre_name)
#endif
,gre_par, gre_lcl, gre_imp = (toList -> gre_imp)}
collectHsBindsBinders :: CollectPass p => Bag (XRec p (HsBindLR p idR)) -> [IdP p]
collectHsBindsBinders :: forall p idR.
CollectPass p =>
Bag (XRec p (HsBindLR p idR)) -> [IdP p]
collectHsBindsBinders Bag (XRec p (HsBindLR p idR))
x = CollectFlag p -> Bag (XRec p (HsBindLR p idR)) -> [IdP p]
forall p idR.
CollectPass p =>
CollectFlag p -> LHsBindsLR p idR -> [IdP p]
GHC.collectHsBindsBinders CollectFlag p
forall p. CollectFlag p
CollNoDictBinders Bag (XRec p (HsBindLR p idR))
x
makeSimpleDetails :: HscEnv -> TcGblEnv -> IO ModDetails
makeSimpleDetails :: HscEnv -> TcGblEnv -> IO ModDetails
makeSimpleDetails HscEnv
hsc_env =
Logger -> TcGblEnv -> IO ModDetails
GHC.makeSimpleDetails
#if MIN_VERSION_ghc(9,3,0)
(HscEnv -> Logger
hsc_logger HscEnv
hsc_env)
#else
hsc_env
#endif
mkIfaceTc :: HscEnv -> GHC.SafeHaskellMode -> ModDetails -> ModSummary -> Maybe CoreProgram -> TcGblEnv -> IO ModIface
mkIfaceTc :: HscEnv
-> SafeHaskellMode
-> ModDetails
-> ModSummary
-> Maybe CoreProgram
-> TcGblEnv
-> IO ModIface
mkIfaceTc HscEnv
hscEnv SafeHaskellMode
shm ModDetails
md ModSummary
_ms Maybe CoreProgram
_mcp =
#if MIN_VERSION_ghc(9,5,0)
HscEnv
-> SafeHaskellMode
-> ModDetails
-> ModSummary
-> Maybe CoreProgram
-> TcGblEnv
-> IO ModIface
GHC.mkIfaceTc HscEnv
hscEnv SafeHaskellMode
shm ModDetails
md ModSummary
_ms Maybe CoreProgram
_mcp
#elif MIN_VERSION_ghc(9,3,0)
GHC.mkIfaceTc hscEnv shm md _ms
#else
GHC.mkIfaceTc hscEnv shm md
#endif
mkBootModDetailsTc :: HscEnv -> TcGblEnv -> IO ModDetails
mkBootModDetailsTc :: HscEnv -> TcGblEnv -> IO ModDetails
mkBootModDetailsTc HscEnv
session = Logger -> TcGblEnv -> IO ModDetails
GHC.mkBootModDetailsTc
#if MIN_VERSION_ghc(9,3,0)
(HscEnv -> Logger
hsc_logger HscEnv
session)
#else
session
#endif
#if !MIN_VERSION_ghc(9,3,0)
type TidyOpts = HscEnv
#endif
initTidyOpts :: HscEnv -> IO TidyOpts
initTidyOpts :: HscEnv -> IO TidyOpts
initTidyOpts =
#if MIN_VERSION_ghc(9,3,0)
HscEnv -> IO TidyOpts
GHC.initTidyOpts
#else
pure
#endif
#if MIN_VERSION_ghc(9,3,0)
driverNoStop :: StopPhase
driverNoStop :: StopPhase
driverNoStop = StopPhase
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
pattern HsFieldBind {hfbAnn, hfbLHS, hfbRHS, hfbPun} <- HsRecField hfbAnn (SrcLoc.unLoc -> hfbLHS) hfbRHS hfbPun where
HsFieldBind ann lhs rhs pun = HsRecField ann (SrcLoc.noLoc lhs) rhs pun
#endif
#if !MIN_VERSION_ghc_boot_th(9,4,1)
pattern NamedFieldPuns :: Extension
pattern NamedFieldPuns = RecordPuns
#endif
groupOrigin :: MatchGroup GhcRn body -> Origin
#if MIN_VERSION_ghc(9,5,0)
mapLoc :: (a -> b) -> SrcLoc.GenLocated l a -> SrcLoc.GenLocated l b
mapLoc :: forall a b l. (a -> b) -> GenLocated l a -> GenLocated l b
mapLoc = (a -> b) -> GenLocated l a -> GenLocated l b
forall a b. (a -> b) -> GenLocated l a -> GenLocated l b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
groupOrigin :: forall body. MatchGroup GhcRn body -> Origin
groupOrigin = MatchGroup GhcRn body -> XMG GhcRn body
MatchGroup GhcRn body -> Origin
forall p body. MatchGroup p body -> XMG p body
mg_ext
#else
mapLoc :: (a -> b) -> SrcLoc.GenLocated l a -> SrcLoc.GenLocated l b
mapLoc = SrcLoc.mapLoc
groupOrigin = mg_origin
#endif
#if !MIN_VERSION_ghc(9,5,0)
mkCgInteractiveGuts :: CgGuts -> CgGuts
mkCgInteractiveGuts = id
emptyHomeModInfoLinkable :: Maybe Linkable
emptyHomeModInfoLinkable = Nothing
justBytecode :: Linkable -> Maybe Linkable
justBytecode = Just
justObjects :: Linkable -> Maybe Linkable
justObjects = Just
homeModInfoByteCode, homeModInfoObject :: HomeModInfo -> Maybe Linkable
homeModInfoByteCode = hm_linkable
homeModInfoObject = hm_linkable
field_label :: a -> a
field_label = id
#endif
mkSimpleTarget :: DynFlags -> FilePath -> Target
#if MIN_VERSION_ghc(9,3,0)
mkSimpleTarget :: DynFlags -> FilePath -> Target
mkSimpleTarget DynFlags
df FilePath
fp = TargetId
-> Bool -> UnitId -> Maybe (InputFileBuffer, UTCTime) -> Target
Target (FilePath -> Maybe Phase -> TargetId
TargetFile FilePath
fp Maybe Phase
forall a. Maybe a
Nothing) Bool
True (DynFlags -> UnitId
homeUnitId_ DynFlags
df) Maybe (InputFileBuffer, UTCTime)
forall a. Maybe a
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)
#endif