{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ViewPatterns #-}
module GHC.Iface.Load (
tcLookupImported_maybe, importDecl,
checkWiredInTyCon, ifCheckWiredInThing,
loadModuleInterface, loadModuleInterfaces,
loadSrcInterface, loadSrcInterface_maybe,
loadInterfaceForName, loadInterfaceForModule,
loadInterface,
loadSysInterface, loadUserInterface, loadPluginInterface,
findAndReadIface, readIface, writeIface,
flagsToIfCompression,
moduleFreeHolesPrecise,
needWiredInHomeIface, loadWiredInHomeIface,
WhereFrom(..),
pprModIfaceSimple,
ifaceStats, pprModIface, showIface,
module Iface_Errors
) where
import GHC.Prelude
import GHC.Platform.Profile
import {-# SOURCE #-} GHC.IfaceToCore
( tcIfaceDecls, tcIfaceRules, tcIfaceInst, tcIfaceFamInst
, tcIfaceAnnotations, tcIfaceCompleteMatches )
import GHC.Driver.Config.Finder
import GHC.Driver.Env
import GHC.Driver.Errors.Types
import GHC.Driver.DynFlags
import GHC.Driver.Hooks
import GHC.Driver.Plugins
import GHC.Iface.Warnings
import GHC.Iface.Syntax
import GHC.Iface.Ext.Fields
import GHC.Iface.Binary
import GHC.Iface.Rename
import GHC.Iface.Env
import GHC.Iface.Errors as Iface_Errors
import GHC.Tc.Errors.Types
import GHC.Tc.Utils.Monad
import GHC.Utils.Binary ( BinData(..) )
import GHC.Utils.Error
import GHC.Utils.Outputable as Outputable
import GHC.Utils.Panic
import GHC.Utils.Constants (debugIsOn)
import GHC.Utils.Logger
import GHC.Utils.Fingerprint( Fingerprint )
import GHC.Settings.Constants
import GHC.Builtin.Names
import GHC.Builtin.Utils
import GHC.Core.Rules
import GHC.Core.TyCon
import GHC.Core.InstEnv
import GHC.Core.FamInstEnv
import GHC.Types.Annotations
import GHC.Types.Name
import GHC.Types.Name.Cache
import GHC.Types.Name.Env
import GHC.Types.Avail
import GHC.Types.Fixity
import GHC.Types.Fixity.Env
import GHC.Types.SourceError
import GHC.Types.SourceFile
import GHC.Types.SafeHaskell
import GHC.Types.TypeEnv
import GHC.Types.Unique.DSet
import GHC.Types.SrcLoc
import GHC.Types.TyThing
import GHC.Types.PkgQual
import GHC.Unit.External
import GHC.Unit.Module
import GHC.Unit.Module.Warnings
import GHC.Unit.Module.ModIface
import GHC.Unit.Module.Deps
import GHC.Unit.State
import GHC.Unit.Home
import GHC.Unit.Home.ModInfo
import GHC.Unit.Finder
import GHC.Unit.Env
import GHC.Data.Maybe
import Control.Monad
import Data.Map ( toList )
import System.FilePath
import System.Directory
import GHC.Driver.Env.KnotVars
import {-# source #-} GHC.Driver.Main (loadIfaceByteCode)
import GHC.Iface.Errors.Types
import Data.Function ((&))
tcLookupImported_maybe :: Name -> TcM (MaybeErr IfaceMessage TyThing)
tcLookupImported_maybe :: Name -> TcM (MaybeErr IfaceMessage TyThing)
tcLookupImported_maybe Name
name
= do { hsc_env <- TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
; mb_thing <- liftIO (lookupType hsc_env name)
; case mb_thing of
Just TyThing
thing -> MaybeErr IfaceMessage TyThing
-> TcM (MaybeErr IfaceMessage TyThing)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TyThing -> MaybeErr IfaceMessage TyThing
forall err val. val -> MaybeErr err val
Succeeded TyThing
thing)
Maybe TyThing
Nothing -> Name -> TcM (MaybeErr IfaceMessage TyThing)
tcImportDecl_maybe Name
name }
tcImportDecl_maybe :: Name -> TcM (MaybeErr IfaceMessage TyThing)
tcImportDecl_maybe :: Name -> TcM (MaybeErr IfaceMessage TyThing)
tcImportDecl_maybe Name
name
| Just TyThing
thing <- Name -> Maybe TyThing
wiredInNameTyThing_maybe Name
name
= do { Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TyThing -> Bool
needWiredInHomeIface TyThing
thing)
(IfG () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. IfG a -> TcRn a
initIfaceTcRn (Name -> IfG ()
forall lcl. Name -> IfM lcl ()
loadWiredInHomeIface Name
name))
; MaybeErr IfaceMessage TyThing
-> TcM (MaybeErr IfaceMessage TyThing)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TyThing -> MaybeErr IfaceMessage TyThing
forall err val. val -> MaybeErr err val
Succeeded TyThing
thing) }
| Bool
otherwise
= IfG (MaybeErr IfaceMessage TyThing)
-> TcM (MaybeErr IfaceMessage TyThing)
forall a. IfG a -> TcRn a
initIfaceTcRn (Name -> IfG (MaybeErr IfaceMessage TyThing)
forall lcl. Name -> IfM lcl (MaybeErr IfaceMessage TyThing)
importDecl Name
name)
importDecl :: Name -> IfM lcl (MaybeErr IfaceMessage TyThing)
importDecl :: forall lcl. Name -> IfM lcl (MaybeErr IfaceMessage TyThing)
importDecl Name
name
= Bool
-> IfM lcl (MaybeErr IfaceMessage TyThing)
-> IfM lcl (MaybeErr IfaceMessage TyThing)
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Name -> Bool
isWiredInName Name
name)) (IfM lcl (MaybeErr IfaceMessage TyThing)
-> IfM lcl (MaybeErr IfaceMessage TyThing))
-> IfM lcl (MaybeErr IfaceMessage TyThing)
-> IfM lcl (MaybeErr IfaceMessage TyThing)
forall a b. (a -> b) -> a -> b
$
do { logger <- IOEnv (Env IfGblEnv lcl) Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
; liftIO $ trace_if logger nd_doc
; mb_iface <- assertPpr (isExternalName name) (ppr name) $
loadInterface nd_doc (nameModule name) ImportBySystem
; case mb_iface of
{ Failed MissingInterfaceError
err_msg -> MaybeErr IfaceMessage TyThing
-> IfM lcl (MaybeErr IfaceMessage TyThing)
forall a. a -> IOEnv (Env IfGblEnv lcl) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeErr IfaceMessage TyThing
-> IfM lcl (MaybeErr IfaceMessage TyThing))
-> MaybeErr IfaceMessage TyThing
-> IfM lcl (MaybeErr IfaceMessage TyThing)
forall a b. (a -> b) -> a -> b
$ IfaceMessage -> MaybeErr IfaceMessage TyThing
forall err val. err -> MaybeErr err val
Failed (IfaceMessage -> MaybeErr IfaceMessage TyThing)
-> IfaceMessage -> MaybeErr IfaceMessage TyThing
forall a b. (a -> b) -> a -> b
$
MissingInterfaceError -> InterfaceLookingFor -> IfaceMessage
Can'tFindInterface MissingInterfaceError
err_msg (Name -> InterfaceLookingFor
LookingForName Name
name)
; Succeeded ModIface
_ -> do
{ eps <- TcRnIf IfGblEnv lcl ExternalPackageState
forall gbl lcl. TcRnIf gbl lcl ExternalPackageState
getEps
; case lookupTypeEnv (eps_PTE eps) name of
Just TyThing
thing -> MaybeErr IfaceMessage TyThing
-> IfM lcl (MaybeErr IfaceMessage TyThing)
forall a. a -> IOEnv (Env IfGblEnv lcl) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeErr IfaceMessage TyThing
-> IfM lcl (MaybeErr IfaceMessage TyThing))
-> MaybeErr IfaceMessage TyThing
-> IfM lcl (MaybeErr IfaceMessage TyThing)
forall a b. (a -> b) -> a -> b
$ TyThing -> MaybeErr IfaceMessage TyThing
forall err val. val -> MaybeErr err val
Succeeded TyThing
thing
Maybe TyThing
Nothing -> MaybeErr IfaceMessage TyThing
-> IfM lcl (MaybeErr IfaceMessage TyThing)
forall a. a -> IOEnv (Env IfGblEnv lcl) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeErr IfaceMessage TyThing
-> IfM lcl (MaybeErr IfaceMessage TyThing))
-> MaybeErr IfaceMessage TyThing
-> IfM lcl (MaybeErr IfaceMessage TyThing)
forall a b. (a -> b) -> a -> b
$ IfaceMessage -> MaybeErr IfaceMessage TyThing
forall err val. err -> MaybeErr err val
Failed (IfaceMessage -> MaybeErr IfaceMessage TyThing)
-> IfaceMessage -> MaybeErr IfaceMessage TyThing
forall a b. (a -> b) -> a -> b
$
Name -> [TyThing] -> IfaceMessage
Can'tFindNameInInterface Name
name
((TyThing -> Bool) -> [TyThing] -> [TyThing]
forall a. (a -> Bool) -> [a] -> [a]
filter TyThing -> Bool
is_interesting ([TyThing] -> [TyThing]) -> [TyThing] -> [TyThing]
forall a b. (a -> b) -> a -> b
$ TypeEnv -> [TyThing]
forall a. NameEnv a -> [a]
nonDetNameEnvElts (TypeEnv -> [TyThing]) -> TypeEnv -> [TyThing]
forall a b. (a -> b) -> a -> b
$ ExternalPackageState -> TypeEnv
eps_PTE ExternalPackageState
eps)
}}}
where
nd_doc :: SDoc
nd_doc = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Need decl for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
is_interesting :: TyThing -> Bool
is_interesting TyThing
thing = HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== HasDebugCallStack => Name -> Module
Name -> Module
nameModule (TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
thing)
checkWiredInTyCon :: TyCon -> TcM ()
checkWiredInTyCon :: TyCon -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkWiredInTyCon TyCon
tc
| Bool -> Bool
not (Name -> Bool
isWiredInName Name
tc_name)
= () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise
= do { mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; logger <- getLogger
; liftIO $ trace_if logger (text "checkWiredInTyCon" <+> ppr tc_name $$ ppr mod)
; assert (isExternalName tc_name )
when (mod /= nameModule tc_name)
(initIfaceTcRn (loadWiredInHomeIface tc_name))
}
where
tc_name :: Name
tc_name = TyCon -> Name
tyConName TyCon
tc
ifCheckWiredInThing :: TyThing -> IfL ()
ifCheckWiredInThing :: TyThing -> IfL ()
ifCheckWiredInThing TyThing
thing
= do { mod <- IfL Module
getIfModule
; let name = TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
thing
; assertPpr (isExternalName name) (ppr name) $
when (needWiredInHomeIface thing && mod /= nameModule name)
(loadWiredInHomeIface name) }
needWiredInHomeIface :: TyThing -> Bool
needWiredInHomeIface :: TyThing -> Bool
needWiredInHomeIface (ATyCon {}) = Bool
True
needWiredInHomeIface TyThing
_ = Bool
False
loadSrcInterface :: SDoc
-> ModuleName
-> IsBootInterface
-> PkgQual
-> RnM ModIface
loadSrcInterface :: SDoc -> ModuleName -> IsBootInterface -> PkgQual -> RnM ModIface
loadSrcInterface SDoc
doc ModuleName
mod IsBootInterface
want_boot PkgQual
maybe_pkg
= do { res <- SDoc
-> ModuleName
-> IsBootInterface
-> PkgQual
-> RnM (MaybeErr MissingInterfaceError ModIface)
loadSrcInterface_maybe SDoc
doc ModuleName
mod IsBootInterface
want_boot PkgQual
maybe_pkg
; case res of
Failed MissingInterfaceError
err ->
TcRnMessage -> RnM ModIface
forall a. TcRnMessage -> TcM a
failWithTc (TcRnMessage -> RnM ModIface) -> TcRnMessage -> RnM ModIface
forall a b. (a -> b) -> a -> b
$
IfaceMessage -> TcRnMessage
TcRnInterfaceError (IfaceMessage -> TcRnMessage) -> IfaceMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$
MissingInterfaceError -> InterfaceLookingFor -> IfaceMessage
Can'tFindInterface MissingInterfaceError
err (InterfaceLookingFor -> IfaceMessage)
-> InterfaceLookingFor -> IfaceMessage
forall a b. (a -> b) -> a -> b
$
ModuleName -> IsBootInterface -> InterfaceLookingFor
LookingForModule ModuleName
mod IsBootInterface
want_boot
Succeeded ModIface
iface ->
ModIface -> RnM ModIface
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ModIface
iface
}
loadSrcInterface_maybe :: SDoc
-> ModuleName
-> IsBootInterface
-> PkgQual
-> RnM (MaybeErr MissingInterfaceError ModIface)
loadSrcInterface_maybe :: SDoc
-> ModuleName
-> IsBootInterface
-> PkgQual
-> RnM (MaybeErr MissingInterfaceError ModIface)
loadSrcInterface_maybe SDoc
doc ModuleName
mod IsBootInterface
want_boot PkgQual
maybe_pkg
= do hsc_env <- TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
res <- liftIO $ findImportedModule hsc_env mod maybe_pkg
case res of
Found ModLocation
_ Module
mod -> IfG (MaybeErr MissingInterfaceError ModIface)
-> RnM (MaybeErr MissingInterfaceError ModIface)
forall a. IfG a -> TcRn a
initIfaceTcRn (IfG (MaybeErr MissingInterfaceError ModIface)
-> RnM (MaybeErr MissingInterfaceError ModIface))
-> IfG (MaybeErr MissingInterfaceError ModIface)
-> RnM (MaybeErr MissingInterfaceError ModIface)
forall a b. (a -> b) -> a -> b
$ SDoc
-> Module
-> WhereFrom
-> IfG (MaybeErr MissingInterfaceError ModIface)
forall lcl.
SDoc
-> Module
-> WhereFrom
-> IfM lcl (MaybeErr MissingInterfaceError ModIface)
loadInterface SDoc
doc Module
mod (IsBootInterface -> WhereFrom
ImportByUser IsBootInterface
want_boot)
FindResult
err -> MaybeErr MissingInterfaceError ModIface
-> RnM (MaybeErr MissingInterfaceError ModIface)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MissingInterfaceError -> MaybeErr MissingInterfaceError ModIface
forall err val. err -> MaybeErr err val
Failed (HscEnv -> ModuleName -> FindResult -> MissingInterfaceError
cannotFindModule HscEnv
hsc_env ModuleName
mod FindResult
err))
loadModuleInterface :: SDoc -> Module -> TcM ModIface
loadModuleInterface :: SDoc -> Module -> RnM ModIface
loadModuleInterface SDoc
doc Module
mod = IfG ModIface -> RnM ModIface
forall a. IfG a -> TcRn a
initIfaceTcRn (SDoc -> Module -> IfG ModIface
forall lcl. SDoc -> Module -> IfM lcl ModIface
loadSysInterface SDoc
doc Module
mod)
loadModuleInterfaces :: SDoc -> [Module] -> TcM ()
loadModuleInterfaces :: SDoc -> [Module] -> IOEnv (Env TcGblEnv TcLclEnv) ()
loadModuleInterfaces SDoc
doc [Module]
mods
| [Module] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Module]
mods = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = IfG () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. IfG a -> TcRn a
initIfaceTcRn ((Module -> IfG ModIface) -> [Module] -> IfG ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Module -> IfG ModIface
load [Module]
mods)
where
load :: Module -> IfG ModIface
load Module
mod = SDoc -> Module -> IfG ModIface
forall lcl. SDoc -> Module -> IfM lcl ModIface
loadSysInterface (SDoc
doc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod)) Module
mod
loadInterfaceForName :: SDoc -> Name -> TcRn ModIface
loadInterfaceForName :: SDoc -> Name -> RnM ModIface
loadInterfaceForName SDoc
doc Name
name
= do { Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debugIsOn (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
do { this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; massertPpr (not (nameIsLocalOrFrom this_mod name)) (ppr name <+> parens doc) }
; Bool -> SDoc -> RnM ModIface -> RnM ModIface
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Name -> Bool
isExternalName Name
name) (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) (RnM ModIface -> RnM ModIface) -> RnM ModIface -> RnM ModIface
forall a b. (a -> b) -> a -> b
$
IfG ModIface -> RnM ModIface
forall a. IfG a -> TcRn a
initIfaceTcRn (IfG ModIface -> RnM ModIface) -> IfG ModIface -> RnM ModIface
forall a b. (a -> b) -> a -> b
$ SDoc -> Module -> IfG ModIface
forall lcl. SDoc -> Module -> IfM lcl ModIface
loadSysInterface SDoc
doc (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name) }
loadInterfaceForModule :: SDoc -> Module -> TcRn ModIface
loadInterfaceForModule :: SDoc -> Module -> RnM ModIface
loadInterfaceForModule SDoc
doc Module
m
= do
Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debugIsOn (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ do
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
massertPpr (this_mod /= m) (ppr m <+> parens doc)
IfG ModIface -> RnM ModIface
forall a. IfG a -> TcRn a
initIfaceTcRn (IfG ModIface -> RnM ModIface) -> IfG ModIface -> RnM ModIface
forall a b. (a -> b) -> a -> b
$ SDoc -> Module -> IfG ModIface
forall lcl. SDoc -> Module -> IfM lcl ModIface
loadSysInterface SDoc
doc Module
m
loadWiredInHomeIface :: Name -> IfM lcl ()
loadWiredInHomeIface :: forall lcl. Name -> IfM lcl ()
loadWiredInHomeIface Name
name
= Bool -> IfM lcl () -> IfM lcl ()
forall a. HasCallStack => Bool -> a -> a
assert (Name -> Bool
isWiredInName Name
name) (IfM lcl () -> IfM lcl ()) -> IfM lcl () -> IfM lcl ()
forall a b. (a -> b) -> a -> b
$
do _ <- SDoc -> Module -> IfM lcl ModIface
forall lcl. SDoc -> Module -> IfM lcl ModIface
loadSysInterface SDoc
doc (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name); return ()
where
doc :: SDoc
doc = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Need home interface for wired-in thing" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
loadSysInterface :: forall lcl. SDoc -> Module -> IfM lcl ModIface
loadSysInterface SDoc
doc Module
mod_name = SDoc -> Module -> WhereFrom -> IfM lcl ModIface
forall lcl. SDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException SDoc
doc Module
mod_name WhereFrom
ImportBySystem
loadUserInterface :: IsBootInterface -> SDoc -> Module -> IfM lcl ModIface
loadUserInterface :: forall lcl. IsBootInterface -> SDoc -> Module -> IfM lcl ModIface
loadUserInterface IsBootInterface
is_boot SDoc
doc Module
mod_name
= SDoc -> Module -> WhereFrom -> IfM lcl ModIface
forall lcl. SDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException SDoc
doc Module
mod_name (IsBootInterface -> WhereFrom
ImportByUser IsBootInterface
is_boot)
loadPluginInterface :: SDoc -> Module -> IfM lcl ModIface
loadPluginInterface :: forall lcl. SDoc -> Module -> IfM lcl ModIface
loadPluginInterface SDoc
doc Module
mod_name
= SDoc -> Module -> WhereFrom -> IfM lcl ModIface
forall lcl. SDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException SDoc
doc Module
mod_name WhereFrom
ImportByPlugin
loadInterfaceWithException :: SDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException :: forall lcl. SDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException SDoc
doc Module
mod_name WhereFrom
where_from
= do
dflags <- IOEnv (Env IfGblEnv lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
let ctx = DynFlags -> PprStyle -> SDocContext
initSDocContext DynFlags
dflags PprStyle
defaultUserStyle
withIfaceErr ctx (loadInterface doc mod_name where_from)
loadInterface :: SDoc -> Module -> WhereFrom
-> IfM lcl (MaybeErr MissingInterfaceError ModIface)
loadInterface :: forall lcl.
SDoc
-> Module
-> WhereFrom
-> IfM lcl (MaybeErr MissingInterfaceError ModIface)
loadInterface SDoc
doc_str Module
mod WhereFrom
from
| Module -> Bool
forall u. GenModule (GenUnit u) -> Bool
isHoleModule Module
mod
= do hsc_env <- TcRnIf IfGblEnv lcl HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
let home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
loadInterface doc_str (mkHomeModule home_unit (moduleName mod)) from
| Bool
otherwise
= do
logger <- IOEnv (Env IfGblEnv lcl) Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
withTimingSilent logger (text "loading interface") (pure ()) $ do
{
(eps,hug) <- getEpsAndHug
; gbl_env <- getGblEnv
; liftIO $ trace_if logger (text "Considering whether to load" <+> ppr mod <+> ppr from)
; hsc_env <- getTopEnv
; let mhome_unit = UnitEnv -> Maybe HomeUnit
ue_homeUnit (HscEnv -> UnitEnv
hsc_unit_env HscEnv
hsc_env)
; case lookupIfaceByModule hug (eps_PIT eps) mod of {
Just ModIface
iface
-> MaybeErr MissingInterfaceError ModIface
-> IfM lcl (MaybeErr MissingInterfaceError ModIface)
forall a. a -> IOEnv (Env IfGblEnv lcl) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModIface -> MaybeErr MissingInterfaceError ModIface
forall err val. val -> MaybeErr err val
Succeeded ModIface
iface) ;
Maybe ModIface
_ -> do {
; read_result <- case Maybe HomeUnit
-> ExternalPackageState
-> Module
-> WhereFrom
-> MaybeErr MissingInterfaceError IsBootInterface
wantHiBootFile Maybe HomeUnit
mhome_unit ExternalPackageState
eps Module
mod WhereFrom
from of
Failed MissingInterfaceError
err -> MaybeErr MissingInterfaceError (ModIface, ModLocation)
-> IOEnv
(Env IfGblEnv lcl)
(MaybeErr MissingInterfaceError (ModIface, ModLocation))
forall a. a -> IOEnv (Env IfGblEnv lcl) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MissingInterfaceError
-> MaybeErr MissingInterfaceError (ModIface, ModLocation)
forall err val. err -> MaybeErr err val
Failed MissingInterfaceError
err)
Succeeded IsBootInterface
hi_boot_file -> do
hsc_env <- TcRnIf IfGblEnv lcl HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
liftIO $ computeInterface hsc_env doc_str hi_boot_file mod
; case read_result of {
Failed MissingInterfaceError
err -> do
{ let fake_iface :: ModIface
fake_iface = Module -> ModIface
emptyFullModIface Module
mod
; (ExternalPackageState -> ExternalPackageState)
-> IOEnv (Env IfGblEnv lcl) ()
forall gbl lcl.
(ExternalPackageState -> ExternalPackageState) -> TcRnIf gbl lcl ()
updateEps_ ((ExternalPackageState -> ExternalPackageState)
-> IOEnv (Env IfGblEnv lcl) ())
-> (ExternalPackageState -> ExternalPackageState)
-> IOEnv (Env IfGblEnv lcl) ()
forall a b. (a -> b) -> a -> b
$ \ExternalPackageState
eps ->
ExternalPackageState
eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface }
; MaybeErr MissingInterfaceError ModIface
-> IfM lcl (MaybeErr MissingInterfaceError ModIface)
forall a. a -> IOEnv (Env IfGblEnv lcl) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MissingInterfaceError -> MaybeErr MissingInterfaceError ModIface
forall err val. err -> MaybeErr err val
Failed MissingInterfaceError
err) } ;
Succeeded (ModIface
iface, ModLocation
loc) ->
let
loc_doc :: SDoc
loc_doc = String -> SDoc
forall doc. IsLine doc => String -> doc
text (ModLocation -> String
ml_hi_file ModLocation
loc)
in
Module
-> SDoc
-> IsBootInterface
-> IfL (MaybeErr MissingInterfaceError ModIface)
-> IfM lcl (MaybeErr MissingInterfaceError ModIface)
forall a lcl.
Module -> SDoc -> IsBootInterface -> IfL a -> IfM lcl a
initIfaceLcl (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_semantic_module ModIface
iface) SDoc
loc_doc (ModIface -> IsBootInterface
mi_boot ModIface
iface) (IfL (MaybeErr MissingInterfaceError ModIface)
-> IfM lcl (MaybeErr MissingInterfaceError ModIface))
-> IfL (MaybeErr MissingInterfaceError ModIface)
-> IfM lcl (MaybeErr MissingInterfaceError ModIface)
forall a b. (a -> b) -> a -> b
$
IfL (MaybeErr MissingInterfaceError ModIface)
-> IfL (MaybeErr MissingInterfaceError ModIface)
forall a. IfL a -> IfL a
dontLeakTheHUG (IfL (MaybeErr MissingInterfaceError ModIface)
-> IfL (MaybeErr MissingInterfaceError ModIface))
-> IfL (MaybeErr MissingInterfaceError ModIface)
-> IfL (MaybeErr MissingInterfaceError ModIface)
forall a b. (a -> b) -> a -> b
$ do
; Bool -> SDoc -> IfL ()
forall (m :: * -> *).
(HasCallStack, Applicative m) =>
Bool -> SDoc -> m ()
massertPpr
((GhcMode -> Bool
isOneShot (DynFlags -> GhcMode
ghcMode (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)))
Bool -> Bool -> Bool
|| Module -> UnitId
moduleUnitId Module
mod UnitId -> Set UnitId -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` HscEnv -> Set UnitId
hsc_all_home_unit_ids HscEnv
hsc_env
Bool -> Bool -> Bool
|| Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
gHC_PRIM)
(String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Attempting to load home package interface into the EPS" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ HomeUnitGraph -> SDoc
forall a. Outputable a => a -> SDoc
ppr HomeUnitGraph
hug SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
doc_str SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> UnitId
moduleUnitId Module
mod))
; ignore_prags <- GeneralFlag -> TcRnIf IfGblEnv IfLclEnv Bool
forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
goptM GeneralFlag
Opt_IgnoreInterfacePragmas
; new_eps_decls <- tcIfaceDecls ignore_prags (mi_decls iface)
; new_eps_insts <- mapM tcIfaceInst (mi_insts iface)
; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
; new_eps_rules <- tcIfaceRules ignore_prags (mi_rules iface)
; new_eps_anns <- tcIfaceAnnotations (mi_anns iface)
; new_eps_complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface)
; purged_hsc_env <- getTopEnv
; let final_iface = ModIface
iface
ModIface -> (ModIface -> ModIface) -> ModIface
forall a b. a -> (a -> b) -> b
& [IfaceDeclExts 'ModIfaceFinal] -> ModIface -> ModIface
forall (phase :: ModIfacePhase).
[IfaceDeclExts phase] -> ModIface_ phase -> ModIface_ phase
set_mi_decls (String -> [(Fingerprint, IfaceDecl)]
forall a. HasCallStack => String -> a
panic String
"No mi_decls in PIT")
ModIface -> (ModIface -> ModIface) -> ModIface
forall a b. a -> (a -> b) -> b
& [IfaceClsInst] -> ModIface -> ModIface
forall (phase :: ModIfacePhase).
[IfaceClsInst] -> ModIface_ phase -> ModIface_ phase
set_mi_insts (String -> [IfaceClsInst]
forall a. HasCallStack => String -> a
panic String
"No mi_insts in PIT")
ModIface -> (ModIface -> ModIface) -> ModIface
forall a b. a -> (a -> b) -> b
& [IfaceFamInst] -> ModIface -> ModIface
forall (phase :: ModIfacePhase).
[IfaceFamInst] -> ModIface_ phase -> ModIface_ phase
set_mi_fam_insts (String -> [IfaceFamInst]
forall a. HasCallStack => String -> a
panic String
"No mi_fam_insts in PIT")
ModIface -> (ModIface -> ModIface) -> ModIface
forall a b. a -> (a -> b) -> b
& [IfaceRule] -> ModIface -> ModIface
forall (phase :: ModIfacePhase).
[IfaceRule] -> ModIface_ phase -> ModIface_ phase
set_mi_rules (String -> [IfaceRule]
forall a. HasCallStack => String -> a
panic String
"No mi_rules in PIT")
ModIface -> (ModIface -> ModIface) -> ModIface
forall a b. a -> (a -> b) -> b
& [IfaceAnnotation] -> ModIface -> ModIface
forall (phase :: ModIfacePhase).
[IfaceAnnotation] -> ModIface_ phase -> ModIface_ phase
set_mi_anns (String -> [IfaceAnnotation]
forall a. HasCallStack => String -> a
panic String
"No mi_anns in PIT")
ModIface -> (ModIface -> ModIface) -> ModIface
forall a b. a -> (a -> b) -> b
& Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
-> ModIface -> ModIface
forall (phase :: ModIfacePhase).
Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
-> ModIface_ phase -> ModIface_ phase
set_mi_extra_decls (String -> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
forall a. HasCallStack => String -> a
panic String
"No mi_extra_decls in PIT")
bad_boot = ModIface -> IsBootInterface
mi_boot ModIface
iface IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot
Bool -> Bool -> Bool
&& Maybe (IfG TypeEnv) -> Bool
forall a. Maybe a -> Bool
isJust (KnotVars (IfG TypeEnv) -> Module -> Maybe (IfG TypeEnv)
forall a. KnotVars a -> Module -> Maybe a
lookupKnotVars (IfGblEnv -> KnotVars (IfG TypeEnv)
if_rec_types IfGblEnv
gbl_env) Module
mod)
add_bytecode ModuleEnv (IO Linkable)
old
| Just IO Linkable
action <- HscEnv -> ModIface -> ModLocation -> TypeEnv -> Maybe (IO Linkable)
loadIfaceByteCode HscEnv
purged_hsc_env ModIface
iface ModLocation
loc ([(Name, TyThing)] -> TypeEnv
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name, TyThing)]
new_eps_decls)
= ModuleEnv (IO Linkable)
-> Module -> IO Linkable -> ModuleEnv (IO Linkable)
forall a. ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv ModuleEnv (IO Linkable)
old Module
mod IO Linkable
action
| Bool
otherwise
= ModuleEnv (IO Linkable)
old
; warnPprTrace bad_boot "loadInterface" (ppr mod) $
updateEps_ $ \ ExternalPackageState
eps ->
if Module -> PackageIfaceTable -> Bool
forall a. Module -> ModuleEnv a -> Bool
elemModuleEnv Module
mod (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) Bool -> Bool -> Bool
|| Maybe HomeUnit -> ModIface -> Bool
is_external_sig Maybe HomeUnit
mhome_unit ModIface
iface
then ExternalPackageState
eps
else if Bool
bad_boot
then ExternalPackageState
eps { eps_PTE = addDeclsToPTE (eps_PTE eps) new_eps_decls }
else
ExternalPackageState
eps {
eps_PIT = extendModuleEnv (eps_PIT eps) mod final_iface,
eps_PTE = addDeclsToPTE (eps_PTE eps) new_eps_decls,
eps_iface_bytecode = add_bytecode (eps_iface_bytecode eps),
eps_rule_base = extendRuleBaseList (eps_rule_base eps)
new_eps_rules,
eps_complete_matches
= eps_complete_matches eps ++ new_eps_complete_matches,
eps_inst_env = extendInstEnvList (eps_inst_env eps)
new_eps_insts,
eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps)
new_eps_fam_insts,
eps_ann_env = extendAnnEnvList (eps_ann_env eps)
new_eps_anns,
eps_mod_fam_inst_env
= let
fam_inst_env =
FamInstEnv -> [FamInst] -> FamInstEnv
extendFamInstEnvList FamInstEnv
emptyFamInstEnv
[FamInst]
new_eps_fam_insts
in
extendModuleEnv (eps_mod_fam_inst_env eps)
mod
fam_inst_env,
eps_stats = addEpsInStats (eps_stats eps)
(length new_eps_decls)
(length new_eps_insts)
(length new_eps_rules) }
;
res <- withPlugins (hsc_plugins hsc_env) (\Plugin
p -> Plugin -> forall lcl. [String] -> ModIface -> IfM lcl ModIface
interfaceLoadAction Plugin
p) iface
; return (Succeeded res)
}}}}
dontLeakTheHUG :: IfL a -> IfL a
dontLeakTheHUG :: forall a. IfL a -> IfL a
dontLeakTheHUG IfL a
thing_inside = do
env <- TcRnIf IfGblEnv IfLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
let
inOneShot =
GhcMode -> Bool
isOneShot (DynFlags -> GhcMode
ghcMode (HscEnv -> DynFlags
hsc_dflags HscEnv
env))
cleanGblEnv IfGblEnv
gbl_env
| Bool
inOneShot = IfGblEnv
gbl_env
| Bool
otherwise = IfGblEnv
gbl_env { if_rec_types = emptyKnotVars }
cleanTopEnv HscEnv
hsc_env =
let
!maybe_type_vars :: Maybe (KnotVars (IORef TypeEnv))
maybe_type_vars | Bool
inOneShot = KnotVars (IORef TypeEnv) -> Maybe (KnotVars (IORef TypeEnv))
forall a. a -> Maybe a
Just (HscEnv -> KnotVars (IORef TypeEnv)
hsc_type_env_vars HscEnv
env)
| Bool
otherwise = Maybe (KnotVars (IORef TypeEnv))
forall a. Maybe a
Nothing
old_unit_env :: UnitEnv
old_unit_env = HscEnv -> UnitEnv
hsc_unit_env HscEnv
hsc_env
keepFor20509 :: HomeModInfo -> Bool
keepFor20509 HomeModInfo
hmi
| Module -> Bool
forall u. GenModule (GenUnit u) -> Bool
isHoleModule (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_semantic_module (HomeModInfo -> ModIface
hm_iface HomeModInfo
hmi)) = Bool
True
| Bool
otherwise = Bool
False
pruneHomeUnitEnv :: HomeUnitEnv -> HomeUnitEnv
pruneHomeUnitEnv HomeUnitEnv
hme = HomeUnitEnv
hme { homeUnitEnv_hpt = emptyHomePackageTable }
!unit_env :: UnitEnv
unit_env
= UnitEnv
old_unit_env
{ ue_home_unit_graph = if anyHpt keepFor20509 (ue_hpt old_unit_env) then ue_home_unit_graph old_unit_env
else unitEnv_map pruneHomeUnitEnv (ue_home_unit_graph old_unit_env)
}
in
HscEnv
hsc_env { hsc_targets = panic "cleanTopEnv: hsc_targets"
, hsc_mod_graph = panic "cleanTopEnv: hsc_mod_graph"
, hsc_IC = panic "cleanTopEnv: hsc_IC"
, hsc_type_env_vars = case maybe_type_vars of
Just KnotVars (IORef TypeEnv)
vars -> KnotVars (IORef TypeEnv)
vars
Maybe (KnotVars (IORef TypeEnv))
Nothing -> String -> KnotVars (IORef TypeEnv)
forall a. HasCallStack => String -> a
panic String
"cleanTopEnv: hsc_type_env_vars"
, hsc_unit_env = unit_env
}
updTopEnv cleanTopEnv $ updGblEnv cleanGblEnv $ do
!_ <- getTopEnv
!_ <- getGblEnv
thing_inside
is_external_sig :: Maybe HomeUnit -> ModIface -> Bool
is_external_sig :: Maybe HomeUnit -> ModIface -> Bool
is_external_sig Maybe HomeUnit
mhome_unit ModIface
iface =
ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_semantic_module ModIface
iface Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
/= ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface Bool -> Bool -> Bool
&&
Maybe HomeUnit -> Module -> Bool
notHomeModuleMaybe Maybe HomeUnit
mhome_unit (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface)
computeInterface
:: HscEnv
-> SDoc
-> IsBootInterface
-> Module
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
computeInterface :: HscEnv
-> SDoc
-> IsBootInterface
-> Module
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
computeInterface HscEnv
hsc_env SDoc
doc_str IsBootInterface
hi_boot_file Module
mod0 = do
Bool -> IO ()
forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
massert (Bool -> Bool
not (Module -> Bool
forall u. GenModule (GenUnit u) -> Bool
isHoleModule Module
mod0))
let mhome_unit :: Maybe HomeUnit
mhome_unit = HscEnv -> Maybe HomeUnit
hsc_home_unit_maybe HscEnv
hsc_env
let find_iface :: GenModule UnitId
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
find_iface GenModule UnitId
m = HscEnv
-> SDoc
-> GenModule UnitId
-> Module
-> IsBootInterface
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
findAndReadIface HscEnv
hsc_env SDoc
doc_str
GenModule UnitId
m Module
mod0 IsBootInterface
hi_boot_file
case Module -> (GenModule UnitId, Maybe InstantiatedModule)
getModuleInstantiation Module
mod0 of
(GenModule UnitId
imod, Just InstantiatedModule
indef)
| Just HomeUnit
home_unit <- Maybe HomeUnit
mhome_unit
, HomeUnit -> Bool
forall u. GenHomeUnit u -> Bool
isHomeUnitIndefinite HomeUnit
home_unit ->
GenModule UnitId
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
find_iface GenModule UnitId
imod IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
-> (MaybeErr MissingInterfaceError (ModIface, ModLocation)
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation)))
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Succeeded (ModIface
iface0, ModLocation
path) ->
HscEnv
-> [(ModuleName, Module)]
-> Maybe NameShape
-> ModIface
-> IO (Either (Messages TcRnMessage) ModIface)
rnModIface HscEnv
hsc_env (GenInstantiatedUnit UnitId -> [(ModuleName, Module)]
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts (InstantiatedModule -> GenInstantiatedUnit UnitId
forall unit. GenModule unit -> unit
moduleUnit InstantiatedModule
indef)) Maybe NameShape
forall a. Maybe a
Nothing ModIface
iface0 IO (Either (Messages TcRnMessage) ModIface)
-> (Either (Messages TcRnMessage) ModIface
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation)))
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right ModIface
x -> MaybeErr MissingInterfaceError (ModIface, ModLocation)
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ModIface, ModLocation)
-> MaybeErr MissingInterfaceError (ModIface, ModLocation)
forall err val. val -> MaybeErr err val
Succeeded (ModIface
x, ModLocation
path))
Left Messages TcRnMessage
errs -> Messages GhcMessage
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
forall (io :: * -> *) a. MonadIO io => Messages GhcMessage -> io a
throwErrors (TcRnMessage -> GhcMessage
GhcTcRnMessage (TcRnMessage -> GhcMessage)
-> Messages TcRnMessage -> Messages GhcMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Messages TcRnMessage
errs)
Failed MissingInterfaceError
err -> MaybeErr MissingInterfaceError (ModIface, ModLocation)
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MissingInterfaceError
-> MaybeErr MissingInterfaceError (ModIface, ModLocation)
forall err val. err -> MaybeErr err val
Failed MissingInterfaceError
err)
(GenModule UnitId
mod, Maybe InstantiatedModule
_) -> GenModule UnitId
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
find_iface GenModule UnitId
mod
moduleFreeHolesPrecise
:: SDoc -> Module
-> TcRnIf gbl lcl (MaybeErr MissingInterfaceError (UniqDSet ModuleName))
moduleFreeHolesPrecise :: forall gbl lcl.
SDoc
-> Module
-> TcRnIf
gbl lcl (MaybeErr MissingInterfaceError (UniqDSet ModuleName))
moduleFreeHolesPrecise SDoc
doc_str Module
mod
| Module -> Bool
moduleIsDefinite Module
mod = MaybeErr MissingInterfaceError (UniqDSet ModuleName)
-> IOEnv
(Env gbl lcl)
(MaybeErr MissingInterfaceError (UniqDSet ModuleName))
forall a. a -> IOEnv (Env gbl lcl) a
forall (m :: * -> *) a. Monad m => a -> m a
return (UniqDSet ModuleName
-> MaybeErr MissingInterfaceError (UniqDSet ModuleName)
forall err val. val -> MaybeErr err val
Succeeded UniqDSet ModuleName
forall a. UniqDSet a
emptyUniqDSet)
| Bool
otherwise =
case Module -> (GenModule UnitId, Maybe InstantiatedModule)
getModuleInstantiation Module
mod of
(GenModule UnitId
imod, Just InstantiatedModule
indef) -> do
logger <- IOEnv (Env gbl lcl) Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
let insts = GenInstantiatedUnit UnitId -> [(ModuleName, Module)]
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts (InstantiatedModule -> GenInstantiatedUnit UnitId
forall unit. GenModule unit -> unit
moduleUnit InstantiatedModule
indef)
liftIO $ trace_if logger (text "Considering whether to load" <+> ppr mod <+>
text "to compute precise free module holes")
(eps, hpt) <- getEpsAndHug
case tryEpsAndHpt eps hpt `firstJust` tryDepsCache eps imod insts of
Just UniqDSet ModuleName
r -> MaybeErr MissingInterfaceError (UniqDSet ModuleName)
-> IOEnv
(Env gbl lcl)
(MaybeErr MissingInterfaceError (UniqDSet ModuleName))
forall a. a -> IOEnv (Env gbl lcl) a
forall (m :: * -> *) a. Monad m => a -> m a
return (UniqDSet ModuleName
-> MaybeErr MissingInterfaceError (UniqDSet ModuleName)
forall err val. val -> MaybeErr err val
Succeeded UniqDSet ModuleName
r)
Maybe (UniqDSet ModuleName)
Nothing -> GenModule UnitId
-> [(ModuleName, Module)]
-> IOEnv
(Env gbl lcl)
(MaybeErr MissingInterfaceError (UniqDSet ModuleName))
readAndCache GenModule UnitId
imod [(ModuleName, Module)]
insts
(GenModule UnitId
_, Maybe InstantiatedModule
Nothing) -> MaybeErr MissingInterfaceError (UniqDSet ModuleName)
-> IOEnv
(Env gbl lcl)
(MaybeErr MissingInterfaceError (UniqDSet ModuleName))
forall a. a -> IOEnv (Env gbl lcl) a
forall (m :: * -> *) a. Monad m => a -> m a
return (UniqDSet ModuleName
-> MaybeErr MissingInterfaceError (UniqDSet ModuleName)
forall err val. val -> MaybeErr err val
Succeeded UniqDSet ModuleName
forall a. UniqDSet a
emptyUniqDSet)
where
tryEpsAndHpt :: ExternalPackageState
-> HomeUnitGraph -> Maybe (UniqDSet ModuleName)
tryEpsAndHpt ExternalPackageState
eps HomeUnitGraph
hpt =
(ModIface -> UniqDSet ModuleName)
-> Maybe ModIface -> Maybe (UniqDSet ModuleName)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModIface -> UniqDSet ModuleName
mi_free_holes (HomeUnitGraph -> PackageIfaceTable -> Module -> Maybe ModIface
lookupIfaceByModule HomeUnitGraph
hpt (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) Module
mod)
tryDepsCache :: ExternalPackageState
-> GenModule UnitId
-> [(ModuleName, Module)]
-> Maybe (UniqDSet ModuleName)
tryDepsCache ExternalPackageState
eps GenModule UnitId
imod [(ModuleName, Module)]
insts =
case InstalledModuleEnv (UniqDSet ModuleName)
-> GenModule UnitId -> Maybe (UniqDSet ModuleName)
forall a. InstalledModuleEnv a -> GenModule UnitId -> Maybe a
lookupInstalledModuleEnv (ExternalPackageState -> InstalledModuleEnv (UniqDSet ModuleName)
eps_free_holes ExternalPackageState
eps) GenModule UnitId
imod of
Just UniqDSet ModuleName
ifhs -> UniqDSet ModuleName -> Maybe (UniqDSet ModuleName)
forall a. a -> Maybe a
Just (UniqDSet ModuleName
-> [(ModuleName, Module)] -> UniqDSet ModuleName
renameFreeHoles UniqDSet ModuleName
ifhs [(ModuleName, Module)]
insts)
Maybe (UniqDSet ModuleName)
_otherwise -> Maybe (UniqDSet ModuleName)
forall a. Maybe a
Nothing
readAndCache :: GenModule UnitId
-> [(ModuleName, Module)]
-> IOEnv
(Env gbl lcl)
(MaybeErr MissingInterfaceError (UniqDSet ModuleName))
readAndCache GenModule UnitId
imod [(ModuleName, Module)]
insts = do
hsc_env <- TcRnIf gbl lcl HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
mb_iface <- liftIO $ findAndReadIface hsc_env
(text "moduleFreeHolesPrecise" <+> doc_str)
imod mod NotBoot
case mb_iface of
Succeeded (ModIface
iface, ModLocation
_) -> do
let ifhs :: UniqDSet ModuleName
ifhs = ModIface -> UniqDSet ModuleName
mi_free_holes ModIface
iface
(ExternalPackageState -> ExternalPackageState)
-> IOEnv (Env gbl lcl) ()
forall gbl lcl.
(ExternalPackageState -> ExternalPackageState) -> TcRnIf gbl lcl ()
updateEps_ (\ExternalPackageState
eps ->
ExternalPackageState
eps { eps_free_holes = extendInstalledModuleEnv (eps_free_holes eps) imod ifhs })
MaybeErr MissingInterfaceError (UniqDSet ModuleName)
-> IOEnv
(Env gbl lcl)
(MaybeErr MissingInterfaceError (UniqDSet ModuleName))
forall a. a -> IOEnv (Env gbl lcl) a
forall (m :: * -> *) a. Monad m => a -> m a
return (UniqDSet ModuleName
-> MaybeErr MissingInterfaceError (UniqDSet ModuleName)
forall err val. val -> MaybeErr err val
Succeeded (UniqDSet ModuleName
-> [(ModuleName, Module)] -> UniqDSet ModuleName
renameFreeHoles UniqDSet ModuleName
ifhs [(ModuleName, Module)]
insts))
Failed MissingInterfaceError
err -> MaybeErr MissingInterfaceError (UniqDSet ModuleName)
-> IOEnv
(Env gbl lcl)
(MaybeErr MissingInterfaceError (UniqDSet ModuleName))
forall a. a -> IOEnv (Env gbl lcl) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MissingInterfaceError
-> MaybeErr MissingInterfaceError (UniqDSet ModuleName)
forall err val. err -> MaybeErr err val
Failed MissingInterfaceError
err)
wantHiBootFile :: Maybe HomeUnit -> ExternalPackageState -> Module -> WhereFrom
-> MaybeErr MissingInterfaceError IsBootInterface
wantHiBootFile :: Maybe HomeUnit
-> ExternalPackageState
-> Module
-> WhereFrom
-> MaybeErr MissingInterfaceError IsBootInterface
wantHiBootFile Maybe HomeUnit
mhome_unit ExternalPackageState
eps Module
mod WhereFrom
from
= case WhereFrom
from of
ImportByUser IsBootInterface
usr_boot
| IsBootInterface
usr_boot IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot Bool -> Bool -> Bool
&& Maybe HomeUnit -> Module -> Bool
notHomeModuleMaybe Maybe HomeUnit
mhome_unit Module
mod
-> MissingInterfaceError
-> MaybeErr MissingInterfaceError IsBootInterface
forall err val. err -> MaybeErr err val
Failed (Module -> MissingInterfaceError
BadSourceImport Module
mod)
| Bool
otherwise -> IsBootInterface -> MaybeErr MissingInterfaceError IsBootInterface
forall err val. val -> MaybeErr err val
Succeeded IsBootInterface
usr_boot
WhereFrom
ImportByPlugin
-> IsBootInterface -> MaybeErr MissingInterfaceError IsBootInterface
forall err val. val -> MaybeErr err val
Succeeded IsBootInterface
NotBoot
WhereFrom
ImportBySystem
| Maybe HomeUnit -> Module -> Bool
notHomeModuleMaybe Maybe HomeUnit
mhome_unit Module
mod
-> IsBootInterface -> MaybeErr MissingInterfaceError IsBootInterface
forall err val. val -> MaybeErr err val
Succeeded IsBootInterface
NotBoot
| Bool
otherwise
-> case InstalledModuleEnv ModuleNameWithIsBoot
-> GenModule UnitId -> Maybe ModuleNameWithIsBoot
forall a. InstalledModuleEnv a -> GenModule UnitId -> Maybe a
lookupInstalledModuleEnv (ExternalPackageState -> InstalledModuleEnv ModuleNameWithIsBoot
eps_is_boot ExternalPackageState
eps) (GenUnit UnitId -> UnitId
toUnitId (GenUnit UnitId -> UnitId) -> Module -> GenModule UnitId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Module
mod) of
Just (GWIB { gwib_isBoot :: forall mod. GenWithIsBoot mod -> IsBootInterface
gwib_isBoot = IsBootInterface
is_boot }) ->
IsBootInterface -> MaybeErr MissingInterfaceError IsBootInterface
forall err val. val -> MaybeErr err val
Succeeded IsBootInterface
is_boot
Maybe ModuleNameWithIsBoot
Nothing ->
IsBootInterface -> MaybeErr MissingInterfaceError IsBootInterface
forall err val. val -> MaybeErr err val
Succeeded IsBootInterface
NotBoot
addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
addDeclsToPTE :: TypeEnv -> [(Name, TyThing)] -> TypeEnv
addDeclsToPTE TypeEnv
pte [(Name, TyThing)]
things = TypeEnv -> [(Name, TyThing)] -> TypeEnv
forall a. NameEnv a -> [(Name, a)] -> NameEnv a
extendNameEnvList TypeEnv
pte [(Name, TyThing)]
things
findAndReadIface
:: HscEnv
-> SDoc
-> InstalledModule
-> Module
-> IsBootInterface
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
findAndReadIface :: HscEnv
-> SDoc
-> GenModule UnitId
-> Module
-> IsBootInterface
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
findAndReadIface HscEnv
hsc_env SDoc
doc_str GenModule UnitId
mod Module
wanted_mod IsBootInterface
hi_boot_file = do
let profile :: Profile
profile = DynFlags -> Profile
targetProfile DynFlags
dflags
unit_state :: UnitState
unit_state = HasDebugCallStack => HscEnv -> UnitState
HscEnv -> UnitState
hsc_units HscEnv
hsc_env
fc :: FinderCache
fc = HscEnv -> FinderCache
hsc_FC HscEnv
hsc_env
name_cache :: NameCache
name_cache = HscEnv -> NameCache
hsc_NC HscEnv
hsc_env
mhome_unit :: Maybe HomeUnit
mhome_unit = HscEnv -> Maybe HomeUnit
hsc_home_unit_maybe HscEnv
hsc_env
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
hooks :: Hooks
hooks = HscEnv -> Hooks
hsc_hooks HscEnv
hsc_env
other_fopts :: UnitEnvGraph FinderOpts
other_fopts = DynFlags -> FinderOpts
initFinderOpts (DynFlags -> FinderOpts)
-> (HomeUnitEnv -> DynFlags) -> HomeUnitEnv -> FinderOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeUnitEnv -> DynFlags
homeUnitEnv_dflags (HomeUnitEnv -> FinderOpts)
-> HomeUnitGraph -> UnitEnvGraph FinderOpts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HscEnv -> HomeUnitGraph
hsc_HUG HscEnv
hsc_env)
Logger -> SDoc -> IO ()
trace_if Logger
logger ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Reading",
if IsBootInterface
hi_boot_file IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot
then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"[boot]"
else SDoc
forall doc. IsOutput doc => doc
Outputable.empty,
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"interface for",
GenModule UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenModule UnitId
mod SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
semi],
Int -> SDoc -> SDoc
nest Int
4 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"reason:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
doc_str)])
if GenModule UnitId
mod GenModule UnitId -> Module -> Bool
`installedModuleEq` Module
gHC_PRIM
then do
let iface :: ModIface
iface = case Hooks -> Maybe ModIface
ghcPrimIfaceHook Hooks
hooks of
Maybe ModIface
Nothing -> ModIface
ghcPrimIface
Just ModIface
h -> ModIface
h
MaybeErr MissingInterfaceError (ModIface, ModLocation)
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ModIface, ModLocation)
-> MaybeErr MissingInterfaceError (ModIface, ModLocation)
forall err val. val -> MaybeErr err val
Succeeded (ModIface
iface, String -> ModLocation
forall a. HasCallStack => String -> a
panic String
"GHC.Prim ModLocation (findAndReadIface)"))
else do
let fopts :: FinderOpts
fopts = DynFlags -> FinderOpts
initFinderOpts DynFlags
dflags
mb_found <- IO InstalledFindResult -> IO InstalledFindResult
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FinderCache
-> FinderOpts
-> UnitEnvGraph FinderOpts
-> UnitState
-> Maybe HomeUnit
-> GenModule UnitId
-> IO InstalledFindResult
findExactModule FinderCache
fc FinderOpts
fopts UnitEnvGraph FinderOpts
other_fopts UnitState
unit_state Maybe HomeUnit
mhome_unit GenModule UnitId
mod)
case mb_found of
InstalledFound (IsBootInterface -> ModLocation -> ModLocation
addBootSuffixLocn_maybe IsBootInterface
hi_boot_file -> ModLocation
loc) GenModule UnitId
mod -> do
case Maybe HomeUnit
mhome_unit of
Just HomeUnit
home_unit
| HomeUnit -> GenModule UnitId -> Bool
forall u. GenHomeUnit u -> GenModule UnitId -> Bool
isHomeInstalledModule HomeUnit
home_unit GenModule UnitId
mod
, Bool -> Bool
not (GhcMode -> Bool
isOneShot (DynFlags -> GhcMode
ghcMode DynFlags
dflags))
-> MaybeErr MissingInterfaceError (ModIface, ModLocation)
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MissingInterfaceError
-> MaybeErr MissingInterfaceError (ModIface, ModLocation)
forall err val. err -> MaybeErr err val
Failed (GenModule UnitId -> ModLocation -> MissingInterfaceError
HomeModError GenModule UnitId
mod ModLocation
loc))
Maybe HomeUnit
_ -> do
r <- Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> String
-> IO (MaybeErr ReadInterfaceError (ModIface, String))
read_file Logger
logger NameCache
name_cache UnitState
unit_state DynFlags
dflags Module
wanted_mod (ModLocation -> String
ml_hi_file ModLocation
loc)
case r of
Failed ReadInterfaceError
err
-> MaybeErr MissingInterfaceError (ModIface, ModLocation)
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MissingInterfaceError
-> MaybeErr MissingInterfaceError (ModIface, ModLocation)
forall err val. err -> MaybeErr err val
Failed (MissingInterfaceError
-> MaybeErr MissingInterfaceError (ModIface, ModLocation))
-> MissingInterfaceError
-> MaybeErr MissingInterfaceError (ModIface, ModLocation)
forall a b. (a -> b) -> a -> b
$ ReadInterfaceError -> MissingInterfaceError
BadIfaceFile ReadInterfaceError
err)
Succeeded (ModIface
iface,String
_fp)
-> do
r2 <- Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> ModIface
-> ModLocation
-> IO (MaybeErr MissingInterfaceError ())
load_dynamic_too_maybe Logger
logger NameCache
name_cache UnitState
unit_state
(DynFlags -> DynFlags
setDynamicNow DynFlags
dflags) Module
wanted_mod
ModIface
iface ModLocation
loc
case r2 of
Failed MissingInterfaceError
sdoc -> MaybeErr MissingInterfaceError (ModIface, ModLocation)
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MissingInterfaceError
-> MaybeErr MissingInterfaceError (ModIface, ModLocation)
forall err val. err -> MaybeErr err val
Failed MissingInterfaceError
sdoc)
Succeeded {} -> MaybeErr MissingInterfaceError (ModIface, ModLocation)
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeErr MissingInterfaceError (ModIface, ModLocation)
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation)))
-> MaybeErr MissingInterfaceError (ModIface, ModLocation)
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
forall a b. (a -> b) -> a -> b
$ (ModIface, ModLocation)
-> MaybeErr MissingInterfaceError (ModIface, ModLocation)
forall err val. val -> MaybeErr err val
Succeeded (ModIface
iface, ModLocation
loc)
InstalledFindResult
err -> do
Logger -> SDoc -> IO ()
trace_if Logger
logger (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"...not found")
MaybeErr MissingInterfaceError (ModIface, ModLocation)
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeErr MissingInterfaceError (ModIface, ModLocation)
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation)))
-> MaybeErr MissingInterfaceError (ModIface, ModLocation)
-> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
forall a b. (a -> b) -> a -> b
$ MissingInterfaceError
-> MaybeErr MissingInterfaceError (ModIface, ModLocation)
forall err val. err -> MaybeErr err val
Failed (MissingInterfaceError
-> MaybeErr MissingInterfaceError (ModIface, ModLocation))
-> MissingInterfaceError
-> MaybeErr MissingInterfaceError (ModIface, ModLocation)
forall a b. (a -> b) -> a -> b
$ UnitState
-> Maybe HomeUnit
-> Profile
-> ModuleName
-> InstalledFindResult
-> MissingInterfaceError
cannotFindInterface
UnitState
unit_state
Maybe HomeUnit
mhome_unit
Profile
profile
(GenModule UnitId -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName GenModule UnitId
mod)
InstalledFindResult
err
load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags
-> Module -> ModIface -> ModLocation
-> IO (MaybeErr MissingInterfaceError ())
load_dynamic_too_maybe :: Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> ModIface
-> ModLocation
-> IO (MaybeErr MissingInterfaceError ())
load_dynamic_too_maybe Logger
logger NameCache
name_cache UnitState
unit_state DynFlags
dflags Module
wanted_mod ModIface
iface ModLocation
loc
| Bool -> Bool
not (Module -> Bool
moduleIsDefinite (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface)) = MaybeErr MissingInterfaceError ()
-> IO (MaybeErr MissingInterfaceError ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> MaybeErr MissingInterfaceError ()
forall err val. val -> MaybeErr err val
Succeeded ())
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_BuildDynamicToo DynFlags
dflags = Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> ModIface
-> ModLocation
-> IO (MaybeErr MissingInterfaceError ())
load_dynamic_too Logger
logger NameCache
name_cache UnitState
unit_state DynFlags
dflags Module
wanted_mod ModIface
iface ModLocation
loc
| Bool
otherwise = MaybeErr MissingInterfaceError ()
-> IO (MaybeErr MissingInterfaceError ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> MaybeErr MissingInterfaceError ()
forall err val. val -> MaybeErr err val
Succeeded ())
load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags
-> Module -> ModIface -> ModLocation
-> IO (MaybeErr MissingInterfaceError ())
load_dynamic_too :: Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> ModIface
-> ModLocation
-> IO (MaybeErr MissingInterfaceError ())
load_dynamic_too Logger
logger NameCache
name_cache UnitState
unit_state DynFlags
dflags Module
wanted_mod ModIface
iface ModLocation
loc = do
Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> String
-> IO (MaybeErr ReadInterfaceError (ModIface, String))
read_file Logger
logger NameCache
name_cache UnitState
unit_state DynFlags
dflags Module
wanted_mod (ModLocation -> String
ml_dyn_hi_file ModLocation
loc) IO (MaybeErr ReadInterfaceError (ModIface, String))
-> (MaybeErr ReadInterfaceError (ModIface, String)
-> IO (MaybeErr MissingInterfaceError ()))
-> IO (MaybeErr MissingInterfaceError ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Succeeded (ModIface
dynIface, String
_)
| ModIfaceBackend -> Fingerprint
mi_mod_hash (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface) Fingerprint -> Fingerprint -> Bool
forall a. Eq a => a -> a -> Bool
== ModIfaceBackend -> Fingerprint
mi_mod_hash (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
dynIface)
-> MaybeErr MissingInterfaceError ()
-> IO (MaybeErr MissingInterfaceError ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> MaybeErr MissingInterfaceError ()
forall err val. val -> MaybeErr err val
Succeeded ())
| Bool
otherwise ->
do MaybeErr MissingInterfaceError ()
-> IO (MaybeErr MissingInterfaceError ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeErr MissingInterfaceError ()
-> IO (MaybeErr MissingInterfaceError ()))
-> MaybeErr MissingInterfaceError ()
-> IO (MaybeErr MissingInterfaceError ())
forall a b. (a -> b) -> a -> b
$ (MissingInterfaceError -> MaybeErr MissingInterfaceError ()
forall err val. err -> MaybeErr err val
Failed (MissingInterfaceError -> MaybeErr MissingInterfaceError ())
-> MissingInterfaceError -> MaybeErr MissingInterfaceError ()
forall a b. (a -> b) -> a -> b
$ Module -> ModLocation -> MissingInterfaceError
DynamicHashMismatchError Module
wanted_mod ModLocation
loc)
Failed ReadInterfaceError
err ->
do MaybeErr MissingInterfaceError ()
-> IO (MaybeErr MissingInterfaceError ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeErr MissingInterfaceError ()
-> IO (MaybeErr MissingInterfaceError ()))
-> MaybeErr MissingInterfaceError ()
-> IO (MaybeErr MissingInterfaceError ())
forall a b. (a -> b) -> a -> b
$ (MissingInterfaceError -> MaybeErr MissingInterfaceError ()
forall err val. err -> MaybeErr err val
Failed (MissingInterfaceError -> MaybeErr MissingInterfaceError ())
-> MissingInterfaceError -> MaybeErr MissingInterfaceError ()
forall a b. (a -> b) -> a -> b
$ Module -> ReadInterfaceError -> MissingInterfaceError
FailedToLoadDynamicInterface Module
wanted_mod ReadInterfaceError
err)
read_file :: Logger -> NameCache -> UnitState -> DynFlags
-> Module -> FilePath
-> IO (MaybeErr ReadInterfaceError (ModIface, FilePath))
read_file :: Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> String
-> IO (MaybeErr ReadInterfaceError (ModIface, String))
read_file Logger
logger NameCache
name_cache UnitState
unit_state DynFlags
dflags Module
wanted_mod String
file_path = do
Logger -> SDoc -> IO ()
trace_if Logger
logger (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"readIFace" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
file_path)
let wanted_mod' :: Module
wanted_mod' =
case Module -> (GenModule UnitId, Maybe InstantiatedModule)
getModuleInstantiation Module
wanted_mod of
(GenModule UnitId
_, Maybe InstantiatedModule
Nothing) -> Module
wanted_mod
(GenModule UnitId
_, Just InstantiatedModule
indef_mod) ->
UnitState -> InstantiatedModule -> Module
instModuleToModule UnitState
unit_state
(InstantiatedModule -> InstantiatedModule
uninstantiateInstantiatedModule InstantiatedModule
indef_mod)
read_result <- DynFlags
-> NameCache
-> Module
-> String
-> IO (MaybeErr ReadInterfaceError ModIface)
readIface DynFlags
dflags NameCache
name_cache Module
wanted_mod' String
file_path
case read_result of
Failed ReadInterfaceError
err -> MaybeErr ReadInterfaceError (ModIface, String)
-> IO (MaybeErr ReadInterfaceError (ModIface, String))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ReadInterfaceError
-> MaybeErr ReadInterfaceError (ModIface, String)
forall err val. err -> MaybeErr err val
Failed ReadInterfaceError
err)
Succeeded ModIface
iface -> MaybeErr ReadInterfaceError (ModIface, String)
-> IO (MaybeErr ReadInterfaceError (ModIface, String))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ModIface, String)
-> MaybeErr ReadInterfaceError (ModIface, String)
forall err val. val -> MaybeErr err val
Succeeded (ModIface
iface, String
file_path))
writeIface :: Logger -> Profile -> CompressionIFace -> FilePath -> ModIface -> IO ()
writeIface :: Logger
-> Profile -> CompressionIFace -> String -> ModIface -> IO ()
writeIface Logger
logger Profile
profile CompressionIFace
compression_level String
hi_file_path ModIface
new_iface
= do Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> String
takeDirectory String
hi_file_path)
let printer :: TraceBinIFace
printer = (SDoc -> IO ()) -> TraceBinIFace
TraceBinIFace (Logger -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger Int
3)
Profile
-> TraceBinIFace -> CompressionIFace -> String -> ModIface -> IO ()
writeBinIface Profile
profile TraceBinIFace
printer CompressionIFace
compression_level String
hi_file_path ModIface
new_iface
flagsToIfCompression :: DynFlags -> CompressionIFace
flagsToIfCompression :: DynFlags -> CompressionIFace
flagsToIfCompression DynFlags
dflags
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = CompressionIFace
NormalCompression
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = CompressionIFace
SafeExtraCompression
| Bool
otherwise = CompressionIFace
MaximumCompression
where n :: Int
n = DynFlags -> Int
ifCompression DynFlags
dflags
readIface
:: DynFlags
-> NameCache
-> Module
-> FilePath
-> IO (MaybeErr ReadInterfaceError ModIface)
readIface :: DynFlags
-> NameCache
-> Module
-> String
-> IO (MaybeErr ReadInterfaceError ModIface)
readIface DynFlags
dflags NameCache
name_cache Module
wanted_mod String
file_path = do
let profile :: Profile
profile = DynFlags -> Profile
targetProfile DynFlags
dflags
res <- IO ModIface -> IO (Either SomeException ModIface)
forall a. IO a -> IO (Either SomeException a)
tryMost (IO ModIface -> IO (Either SomeException ModIface))
-> IO ModIface -> IO (Either SomeException ModIface)
forall a b. (a -> b) -> a -> b
$ Profile
-> NameCache
-> CheckHiWay
-> TraceBinIFace
-> String
-> IO ModIface
readBinIface Profile
profile NameCache
name_cache CheckHiWay
CheckHiWay TraceBinIFace
QuietBinIFace String
file_path
case res of
Right ModIface
iface
| Module
wanted_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
actual_mod
-> MaybeErr ReadInterfaceError ModIface
-> IO (MaybeErr ReadInterfaceError ModIface)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModIface -> MaybeErr ReadInterfaceError ModIface
forall err val. val -> MaybeErr err val
Succeeded ModIface
iface)
| Bool
otherwise -> MaybeErr ReadInterfaceError ModIface
-> IO (MaybeErr ReadInterfaceError ModIface)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ReadInterfaceError -> MaybeErr ReadInterfaceError ModIface
forall err val. err -> MaybeErr err val
Failed ReadInterfaceError
err)
where
actual_mod :: Module
actual_mod = ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface
err :: ReadInterfaceError
err = String -> Module -> Module -> ReadInterfaceError
HiModuleNameMismatchWarn String
file_path Module
wanted_mod Module
actual_mod
Left SomeException
exn -> MaybeErr ReadInterfaceError ModIface
-> IO (MaybeErr ReadInterfaceError ModIface)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ReadInterfaceError -> MaybeErr ReadInterfaceError ModIface
forall err val. err -> MaybeErr err val
Failed (String -> SomeException -> ReadInterfaceError
ExceptionOccurred String
file_path SomeException
exn))
ghcPrimIface :: ModIface
ghcPrimIface :: ModIface
ghcPrimIface
= ModIface
empty_iface
ModIface -> (ModIface -> ModIface) -> ModIface
forall a b. a -> (a -> b) -> b
& [IfaceExport] -> ModIface -> ModIface
forall (phase :: ModIfacePhase).
[IfaceExport] -> ModIface_ phase -> ModIface_ phase
set_mi_exports [IfaceExport]
ghcPrimExports
ModIface -> (ModIface -> ModIface) -> ModIface
forall a b. a -> (a -> b) -> b
& [IfaceDeclExts 'ModIfaceFinal] -> ModIface -> ModIface
forall (phase :: ModIfacePhase).
[IfaceDeclExts phase] -> ModIface_ phase -> ModIface_ phase
set_mi_decls []
ModIface -> (ModIface -> ModIface) -> ModIface
forall a b. a -> (a -> b) -> b
& [(OccName, Fixity)] -> ModIface -> ModIface
forall (phase :: ModIfacePhase).
[(OccName, Fixity)] -> ModIface_ phase -> ModIface_ phase
set_mi_fixities [(OccName, Fixity)]
ghcPrimFixities
ModIface -> (ModIface -> ModIface) -> ModIface
forall a b. a -> (a -> b) -> b
& IfaceBackendExts 'ModIfaceFinal -> ModIface -> ModIface
forall (phase :: ModIfacePhase).
IfaceBackendExts phase -> ModIface_ phase -> ModIface_ phase
set_mi_final_exts ((ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
empty_iface)
{ mi_fix_fn = mkIfaceFixCache ghcPrimFixities
, mi_decl_warn_fn = mkIfaceDeclWarnCache ghcPrimWarns
, mi_export_warn_fn = mkIfaceExportWarnCache ghcPrimWarns
})
ModIface -> (ModIface -> ModIface) -> ModIface
forall a b. a -> (a -> b) -> b
& Maybe Docs -> ModIface -> ModIface
forall (phase :: ModIfacePhase).
Maybe Docs -> ModIface_ phase -> ModIface_ phase
set_mi_docs (Docs -> Maybe Docs
forall a. a -> Maybe a
Just Docs
ghcPrimDeclDocs)
ModIface -> (ModIface -> ModIface) -> ModIface
forall a b. a -> (a -> b) -> b
& IfaceWarnings -> ModIface -> ModIface
forall (phase :: ModIfacePhase).
IfaceWarnings -> ModIface_ phase -> ModIface_ phase
set_mi_warns (Warnings GhcRn -> IfaceWarnings
toIfaceWarnings Warnings GhcRn
forall a. Warnings a
ghcPrimWarns)
where
empty_iface :: ModIface
empty_iface = Module -> ModIface
emptyFullModIface Module
gHC_PRIM
ifaceStats :: ExternalPackageState -> SDoc
ifaceStats :: ExternalPackageState -> SDoc
ifaceStats ExternalPackageState
eps
= [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Renamer stats: ", SDoc
msg]
where
stats :: EpsStats
stats = ExternalPackageState -> EpsStats
eps_stats ExternalPackageState
eps
msg :: SDoc
msg = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
[Int -> SDoc
forall doc. IsLine doc => Int -> doc
int (EpsStats -> Int
n_ifaces_in EpsStats
stats) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"interfaces read",
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ Int -> SDoc
forall doc. IsLine doc => Int -> doc
int (EpsStats -> Int
n_decls_out EpsStats
stats), String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type/class/variable imported, out of",
Int -> SDoc
forall doc. IsLine doc => Int -> doc
int (EpsStats -> Int
n_decls_in EpsStats
stats), String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"read"],
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ Int -> SDoc
forall doc. IsLine doc => Int -> doc
int (EpsStats -> Int
n_insts_out EpsStats
stats), String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"instance decls imported, out of",
Int -> SDoc
forall doc. IsLine doc => Int -> doc
int (EpsStats -> Int
n_insts_in EpsStats
stats), String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"read"],
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ Int -> SDoc
forall doc. IsLine doc => Int -> doc
int (EpsStats -> Int
n_rules_out EpsStats
stats), String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"rule decls imported, out of",
Int -> SDoc
forall doc. IsLine doc => Int -> doc
int (EpsStats -> Int
n_rules_in EpsStats
stats), String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"read"]
]
showIface :: Logger -> DynFlags -> UnitState -> NameCache -> FilePath -> IO ()
showIface :: Logger -> DynFlags -> UnitState -> NameCache -> String -> IO ()
showIface Logger
logger DynFlags
dflags UnitState
unit_state NameCache
name_cache String
filename = do
let profile :: Profile
profile = DynFlags -> Profile
targetProfile DynFlags
dflags
printer :: SDoc -> IO ()
printer = Logger -> MessageClass -> SrcSpan -> SDoc -> IO ()
logMsg Logger
logger MessageClass
MCOutput SrcSpan
noSrcSpan (SDoc -> IO ()) -> (SDoc -> SDoc) -> SDoc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PprStyle -> SDoc -> SDoc
withPprStyle PprStyle
defaultDumpStyle
iface <- Profile
-> NameCache
-> CheckHiWay
-> TraceBinIFace
-> String
-> IO ModIface
readBinIface Profile
profile NameCache
name_cache CheckHiWay
IgnoreHiWay ((SDoc -> IO ()) -> TraceBinIFace
TraceBinIFace SDoc -> IO ()
printer) String
filename
let
qualifyImportedNames Module
mod OccName
_
| Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface = QualifyName
NameUnqual
| Bool
otherwise = QualifyName
NameNotInScope1
name_ppr_ctx = (Module -> OccName -> QualifyName)
-> (Module -> Bool)
-> QueryQualifyPackage
-> QueryPromotionTick
-> NamePprCtx
QueryQualify Module -> OccName -> QualifyName
qualifyImportedNames
Module -> Bool
neverQualifyModules
QueryQualifyPackage
neverQualifyPackages
QueryPromotionTick
alwaysPrintPromTick
logMsg logger MCDump noSrcSpan
$ withPprStyle (mkDumpStyle name_ppr_ctx)
$ pprModIface unit_state iface
pprModIfaceSimple :: UnitState -> ModIface -> SDoc
pprModIfaceSimple :: UnitState -> ModIface -> SDoc
pprModIfaceSimple UnitState
unit_state ModIface
iface =
Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface)
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ UnitState -> Dependencies -> SDoc
pprDeps UnitState
unit_state (ModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps ModIface
iface)
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((IfaceExport -> SDoc) -> [IfaceExport] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceExport -> SDoc
pprExport (ModIface -> [IfaceExport]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceExport]
mi_exports ModIface
iface)))
pprModIface :: UnitState -> ModIface -> SDoc
pprModIface :: UnitState -> ModIface -> SDoc
pprModIface UnitState
unit_state ModIface
iface
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"interface"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HscSource -> SDoc
forall {doc}. IsLine doc => HscSource -> doc
pp_hsc_src (ModIface -> HscSource
forall (phase :: ModIfacePhase). ModIface_ phase -> HscSource
mi_hsc_src ModIface
iface)
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (if ModIfaceBackend -> Bool
mi_orphan IfaceBackendExts 'ModIfaceFinal
ModIfaceBackend
exts then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"[orphan module]" else SDoc
forall doc. IsOutput doc => doc
Outputable.empty)
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (if ModIfaceBackend -> Bool
mi_finsts IfaceBackendExts 'ModIfaceFinal
ModIfaceBackend
exts then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"[family instance module]" else SDoc
forall doc. IsOutput doc => doc
Outputable.empty)
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (if ModIface -> Bool
forall (phase :: ModIfacePhase). ModIface_ phase -> Bool
mi_hpc ModIface
iface then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"[hpc]" else SDoc
forall doc. IsOutput doc => doc
Outputable.empty)
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
hiVersion
, Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"interface hash:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIfaceBackend -> Fingerprint
mi_iface_hash IfaceBackendExts 'ModIfaceFinal
ModIfaceBackend
exts))
, Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ABI hash:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIfaceBackend -> Fingerprint
mi_mod_hash IfaceBackendExts 'ModIfaceFinal
ModIfaceBackend
exts))
, Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"export-list hash:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIfaceBackend -> Fingerprint
mi_exp_hash IfaceBackendExts 'ModIfaceFinal
ModIfaceBackend
exts))
, Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"orphan hash:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIfaceBackend -> Fingerprint
mi_orphan_hash IfaceBackendExts 'ModIfaceFinal
ModIfaceBackend
exts))
, Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"flag hash:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIfaceBackend -> Fingerprint
mi_flag_hash IfaceBackendExts 'ModIfaceFinal
ModIfaceBackend
exts))
, Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"opt_hash:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIfaceBackend -> Fingerprint
mi_opt_hash IfaceBackendExts 'ModIfaceFinal
ModIfaceBackend
exts))
, Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"hpc_hash:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIfaceBackend -> Fingerprint
mi_hpc_hash IfaceBackendExts 'ModIfaceFinal
ModIfaceBackend
exts))
, Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"plugin_hash:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIfaceBackend -> Fingerprint
mi_plugin_hash IfaceBackendExts 'ModIfaceFinal
ModIfaceBackend
exts))
, Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"src_hash:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> Fingerprint
forall (phase :: ModIfacePhase). ModIface_ phase -> Fingerprint
mi_src_hash ModIface
iface))
, Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"sig of:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Maybe Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> Maybe Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Maybe Module
mi_sig_of ModIface
iface))
, Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"used TH splices:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> Bool
forall (phase :: ModIfacePhase). ModIface_ phase -> Bool
mi_used_th ModIface
iface))
, Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"where")
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"exports:"
, Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((IfaceExport -> SDoc) -> [IfaceExport] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceExport -> SDoc
pprExport (ModIface -> [IfaceExport]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceExport]
mi_exports ModIface
iface)))
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"defaults:"
, Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((IfaceDefault -> SDoc) -> [IfaceDefault] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceDefault -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> [IfaceDefault]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceDefault]
mi_defaults ModIface
iface)))
, UnitState -> Dependencies -> SDoc
pprDeps UnitState
unit_state (ModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps ModIface
iface)
, [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((Usage -> SDoc) -> [Usage] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Usage -> SDoc
pprUsage (ModIface -> [Usage]
forall (phase :: ModIfacePhase). ModIface_ phase -> [Usage]
mi_usages ModIface
iface))
, [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((IfaceAnnotation -> SDoc) -> [IfaceAnnotation] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceAnnotation -> SDoc
pprIfaceAnnotation (ModIface -> [IfaceAnnotation]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns ModIface
iface))
, [(OccName, Fixity)] -> SDoc
pprFixities (ModIface -> [(OccName, Fixity)]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [(OccName, Fixity)]
mi_fixities ModIface
iface)
, [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fingerprint
ver SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 (IfaceDecl -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceDecl
decl) | (Fingerprint
ver,IfaceDecl
decl) <- ModIface -> [IfaceDeclExts 'ModIfaceFinal]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls ModIface
iface]
, case ModIface -> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
forall (phase :: ModIfacePhase).
ModIface_ phase
-> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
mi_extra_decls ModIface
iface of
Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
Nothing -> SDoc
forall doc. IsOutput doc => doc
empty
Just [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
eds -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"extra decls:"
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo
bs | IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo
bs <- [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
eds]))
, [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((IfaceClsInst -> SDoc) -> [IfaceClsInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceClsInst -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> [IfaceClsInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts ModIface
iface))
, [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((IfaceFamInst -> SDoc) -> [IfaceFamInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceFamInst -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> [IfaceFamInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts ModIface
iface))
, [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((IfaceRule -> SDoc) -> [IfaceRule] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceRule -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> [IfaceRule]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules ModIface
iface))
, IfaceWarnings -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> IfaceWarnings
forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceWarnings
mi_warns ModIface
iface)
, IfaceTrustInfo -> SDoc
pprTrustInfo (ModIface -> IfaceTrustInfo
forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceTrustInfo
mi_trust ModIface
iface)
, Bool -> SDoc
pprTrustPkg (ModIface -> Bool
forall (phase :: ModIfacePhase). ModIface_ phase -> Bool
mi_trust_pkg ModIface
iface)
, [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((IfaceCompleteMatch -> SDoc) -> [IfaceCompleteMatch] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceCompleteMatch -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> [IfaceCompleteMatch]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_matches ModIface
iface))
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"docs:" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 (Maybe Docs -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> Maybe Docs
forall (phase :: ModIfacePhase). ModIface_ phase -> Maybe Docs
mi_docs ModIface
iface))
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"extensible fields:" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 (ExtensibleFields -> SDoc
pprExtensibleFields (ModIface -> ExtensibleFields
forall (phase :: ModIfacePhase).
ModIface_ phase -> ExtensibleFields
mi_ext_fields ModIface
iface))
]
where
exts :: IfaceBackendExts 'ModIfaceFinal
exts = ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface
pp_hsc_src :: HscSource -> doc
pp_hsc_src HscSource
HsBootFile = String -> doc
forall doc. IsLine doc => String -> doc
text String
"[boot]"
pp_hsc_src HscSource
HsigFile = String -> doc
forall doc. IsLine doc => String -> doc
text String
"[hsig]"
pp_hsc_src HscSource
HsSrcFile = doc
forall doc. IsOutput doc => doc
Outputable.empty
pprExport :: IfaceExport -> SDoc
pprExport :: IfaceExport -> SDoc
pprExport (Avail Name
n) = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n
pprExport (AvailTC Name
_ []) = SDoc
forall doc. IsOutput doc => doc
Outputable.empty
pprExport avail :: IfaceExport
avail@(AvailTC Name
n [Name]
_) =
Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
mark SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Name] -> SDoc
forall {a}. Outputable a => [a] -> SDoc
pp_export (IfaceExport -> [Name]
availSubordinateNames IfaceExport
avail)
where
mark :: SDoc
mark | IfaceExport -> Bool
availExportsDecl IfaceExport
avail = SDoc
forall doc. IsOutput doc => doc
Outputable.empty
| Bool
otherwise = SDoc
forall doc. IsLine doc => doc
vbar
pp_export :: [a] -> SDoc
pp_export [] = SDoc
forall doc. IsOutput doc => doc
Outputable.empty
pp_export [a]
names = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ((a -> SDoc) -> [a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map a -> SDoc
forall a. Outputable a => a -> SDoc
ppr [a]
names))
pprUsage :: Usage -> SDoc
pprUsage :: Usage -> SDoc
pprUsage UsagePackageModule{ usg_mod :: Usage -> Module
usg_mod = Module
mod, usg_mod_hash :: Usage -> Fingerprint
usg_mod_hash = Fingerprint
hash, usg_safe :: Usage -> Bool
usg_safe = Bool
safe }
= Module -> Fingerprint -> Bool -> SDoc
forall mod. Outputable mod => mod -> Fingerprint -> Bool -> SDoc
pprUsageImport Module
mod Fingerprint
hash Bool
safe
pprUsage UsageHomeModule{ usg_unit_id :: Usage -> UnitId
usg_unit_id = UnitId
unit_id, usg_mod_name :: Usage -> ModuleName
usg_mod_name = ModuleName
mod_name
, usg_mod_hash :: Usage -> Fingerprint
usg_mod_hash = Fingerprint
hash, usg_safe :: Usage -> Bool
usg_safe = Bool
safe
, usg_exports :: Usage -> Maybe Fingerprint
usg_exports = Maybe Fingerprint
exports, usg_entities :: Usage -> [(OccName, Fingerprint)]
usg_entities = [(OccName, Fingerprint)]
entities }
= GenModule UnitId -> Fingerprint -> Bool -> SDoc
forall mod. Outputable mod => mod -> Fingerprint -> Bool -> SDoc
pprUsageImport (UnitId -> ModuleName -> GenModule UnitId
forall u. u -> ModuleName -> GenModule u
mkModule UnitId
unit_id ModuleName
mod_name) Fingerprint
hash Bool
safe SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Int -> SDoc -> SDoc
nest Int
2 (
SDoc -> (Fingerprint -> SDoc) -> Maybe Fingerprint -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
forall doc. IsOutput doc => doc
Outputable.empty (\Fingerprint
v -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"exports: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fingerprint
v) Maybe Fingerprint
exports SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fingerprint
v | (OccName
n,Fingerprint
v) <- [(OccName, Fingerprint)]
entities ]
)
pprUsage usage :: Usage
usage@UsageFile{}
= [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"addDependentFile",
SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
doubleQuotes (FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext (Usage -> FastString
usg_file_path Usage
usage)),
Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Usage -> Fingerprint
usg_file_hash Usage
usage)]
pprUsage usage :: Usage
usage@UsageMergedRequirement{}
= [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"merged", Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Usage -> Module
usg_mod Usage
usage), Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Usage -> Fingerprint
usg_mod_hash Usage
usage)]
pprUsage usage :: Usage
usage@UsageHomeModuleInterface{}
= [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"implementation", ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Usage -> ModuleName
usg_mod_name Usage
usage)
, UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Usage -> UnitId
usg_unit_id Usage
usage)
, Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Usage -> Fingerprint
usg_iface_hash Usage
usage)]
pprUsageImport :: Outputable mod => mod -> Fingerprint -> IsSafeImport -> SDoc
pprUsageImport :: forall mod. Outputable mod => mod -> Fingerprint -> Bool -> SDoc
pprUsageImport mod
mod Fingerprint
hash Bool
safe
= [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"import", SDoc
pp_safe, mod -> SDoc
forall a. Outputable a => a -> SDoc
ppr mod
mod
, Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fingerprint
hash ]
where
pp_safe :: SDoc
pp_safe | Bool
safe = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"safe"
| Bool
otherwise = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" -/ "
pprFixities :: [(OccName, Fixity)] -> SDoc
pprFixities :: [(OccName, Fixity)] -> SDoc
pprFixities [] = SDoc
forall doc. IsOutput doc => doc
Outputable.empty
pprFixities [(OccName, Fixity)]
fixes = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"fixities" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ((OccName, Fixity) -> SDoc) -> [(OccName, Fixity)] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas (OccName, Fixity) -> SDoc
forall {a} {a}. (Outputable a, Outputable a) => (a, a) -> SDoc
pprFix [(OccName, Fixity)]
fixes
where
pprFix :: (a, a) -> SDoc
pprFix (a
occ,a
fix) = a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
fix SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
occ
pprTrustInfo :: IfaceTrustInfo -> SDoc
pprTrustInfo :: IfaceTrustInfo -> SDoc
pprTrustInfo IfaceTrustInfo
trust = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"trusted:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceTrustInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTrustInfo
trust
pprTrustPkg :: Bool -> SDoc
pprTrustPkg :: Bool -> SDoc
pprTrustPkg Bool
tpkg = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"require own pkg trusted:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
tpkg
pprIfaceAnnotation :: IfaceAnnotation -> SDoc
pprIfaceAnnotation :: IfaceAnnotation -> SDoc
pprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget :: IfaceAnnotation -> IfaceAnnTarget
ifAnnotatedTarget = IfaceAnnTarget
target, ifAnnotatedValue :: IfaceAnnotation -> AnnPayload
ifAnnotatedValue = AnnPayload
serialized })
= IfaceAnnTarget -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceAnnTarget
target SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"annotated by" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> AnnPayload -> SDoc
forall a. Outputable a => a -> SDoc
ppr AnnPayload
serialized
pprExtensibleFields :: ExtensibleFields -> SDoc
pprExtensibleFields :: ExtensibleFields -> SDoc
pprExtensibleFields (ExtensibleFields Map String BinData
fs) = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc)
-> ([(String, BinData)] -> [SDoc]) -> [(String, BinData)] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, BinData) -> SDoc) -> [(String, BinData)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (String, BinData) -> SDoc
pprField ([(String, BinData)] -> SDoc) -> [(String, BinData)] -> SDoc
forall a b. (a -> b) -> a -> b
$ Map String BinData -> [(String, BinData)]
forall k a. Map k a -> [(k, a)]
toList Map String BinData
fs
where
pprField :: (String, BinData) -> SDoc
pprField (String
name, (BinData Int
size BinArray
_data)) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
size SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bytes"
data WhereFrom
= ImportByUser IsBootInterface
| ImportBySystem
| ImportByPlugin
instance Outputable WhereFrom where
ppr :: WhereFrom -> SDoc
ppr (ImportByUser IsBootInterface
IsBoot) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"{- SOURCE -}"
ppr (ImportByUser IsBootInterface
NotBoot) = SDoc
forall doc. IsOutput doc => doc
empty
ppr WhereFrom
ImportBySystem = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"{- SYSTEM -}"
ppr WhereFrom
ImportByPlugin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"{- PLUGIN -}"