{-# LANGUAGE CPP, BangPatterns, RecordWildCards, NondecreasingIndentation #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module GHC.Iface.Load (
tcLookupImported_maybe, importDecl,
checkWiredInTyCon, ifCheckWiredInThing,
loadModuleInterface, loadModuleInterfaces,
loadSrcInterface, loadSrcInterface_maybe,
loadInterfaceForName, loadInterfaceForNameMaybe, loadInterfaceForModule,
loadInterface,
loadSysInterface, loadUserInterface, loadPluginInterface,
findAndReadIface, readIface, writeIface,
initExternalPackageState,
moduleFreeHolesPrecise,
needWiredInHomeIface, loadWiredInHomeIface,
pprModIfaceSimple,
ifaceStats, pprModIface, showIface,
cannotFindModule
) where
#include "GhclibHsVersions.h"
import GHC.Prelude
import GHC.Platform.Ways
import GHC.Platform.Profile
import {-# SOURCE #-} GHC.IfaceToCore
( tcIfaceDecls, tcIfaceRules, tcIfaceInst, tcIfaceFamInst
, tcIfaceAnnotations, tcIfaceCompleteMatches )
import GHC.Driver.Env
import GHC.Driver.Session
import GHC.Driver.Backend
import GHC.Driver.Ppr
import GHC.Driver.Hooks
import GHC.Driver.Plugins
import GHC.Iface.Syntax
import GHC.Iface.Ext.Fields
import GHC.Iface.Binary
import GHC.Iface.Rename
import GHC.Iface.Env
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.Misc
import GHC.Utils.Logger
import GHC.Settings.Constants
import GHC.Builtin.Names
import GHC.Builtin.Utils
import GHC.Builtin.PrimOps ( allThePrimOps, primOpFixity, primOpOcc )
import GHC.Core.Rules
import GHC.Core.TyCon
import GHC.Core.InstEnv
import GHC.Core.FamInstEnv
import GHC.Types.Id.Make ( seqId )
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.SourceText
import GHC.Types.SourceFile
import GHC.Types.SafeHaskell
import GHC.Types.TypeEnv
import GHC.Types.Unique.FM
import GHC.Types.Unique.DSet
import GHC.Types.SrcLoc
import GHC.Types.TyThing
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 GHC.Data.FastString
import Control.Monad
import Control.Exception
import Data.Map ( toList )
import System.FilePath
import System.Directory
tcLookupImported_maybe :: Name -> TcM (MaybeErr SDoc TyThing)
tcLookupImported_maybe :: Name -> TcM (MaybeErr SDoc TyThing)
tcLookupImported_maybe Name
name
= do { HscEnv
hsc_env <- TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
; Maybe TyThing
mb_thing <- IO (Maybe TyThing) -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe TyThing)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> Name -> IO (Maybe TyThing)
lookupType HscEnv
hsc_env Name
name)
; case Maybe TyThing
mb_thing of
Just TyThing
thing -> MaybeErr SDoc TyThing -> TcM (MaybeErr SDoc TyThing)
forall (m :: * -> *) a. Monad m => a -> m a
return (TyThing -> MaybeErr SDoc TyThing
forall err val. val -> MaybeErr err val
Succeeded TyThing
thing)
Maybe TyThing
Nothing -> Name -> TcM (MaybeErr SDoc TyThing)
tcImportDecl_maybe Name
name }
tcImportDecl_maybe :: Name -> TcM (MaybeErr SDoc TyThing)
tcImportDecl_maybe :: Name -> TcM (MaybeErr SDoc 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 SDoc TyThing -> TcM (MaybeErr SDoc TyThing)
forall (m :: * -> *) a. Monad m => a -> m a
return (TyThing -> MaybeErr SDoc TyThing
forall err val. val -> MaybeErr err val
Succeeded TyThing
thing) }
| Bool
otherwise
= IfG (MaybeErr SDoc TyThing) -> TcM (MaybeErr SDoc TyThing)
forall a. IfG a -> TcRn a
initIfaceTcRn (Name -> IfG (MaybeErr SDoc TyThing)
forall lcl. Name -> IfM lcl (MaybeErr SDoc TyThing)
importDecl Name
name)
importDecl :: Name -> IfM lcl (MaybeErr SDoc TyThing)
importDecl :: Name -> IfM lcl (MaybeErr SDoc TyThing)
importDecl Name
name
= ASSERT( not (isWiredInName name) )
do { DynFlags
dflags <- IOEnv (Env IfGblEnv lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; Logger
logger <- IOEnv (Env IfGblEnv lcl) Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
; IO () -> IOEnv (Env IfGblEnv lcl) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env IfGblEnv lcl) ())
-> IO () -> IOEnv (Env IfGblEnv lcl) ()
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> SDoc -> IO ()
trace_if Logger
logger DynFlags
dflags SDoc
nd_doc
; MaybeErr SDoc ModIface
mb_iface <- ASSERT2( isExternalName name, ppr name )
SDoc
-> Module
-> WhereFrom
-> IOEnv (Env IfGblEnv lcl) (MaybeErr SDoc ModIface)
forall lcl.
SDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr SDoc ModIface)
loadInterface SDoc
nd_doc (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name) WhereFrom
ImportBySystem
; case MaybeErr SDoc ModIface
mb_iface of {
Failed SDoc
err_msg -> MaybeErr SDoc TyThing -> IfM lcl (MaybeErr SDoc TyThing)
forall (m :: * -> *) a. Monad m => a -> m a
return (SDoc -> MaybeErr SDoc TyThing
forall err val. err -> MaybeErr err val
Failed SDoc
err_msg) ;
Succeeded ModIface
_ -> do
{ ExternalPackageState
eps <- TcRnIf IfGblEnv lcl ExternalPackageState
forall gbl lcl. TcRnIf gbl lcl ExternalPackageState
getEps
; case TypeEnv -> Name -> Maybe TyThing
lookupTypeEnv (ExternalPackageState -> TypeEnv
eps_PTE ExternalPackageState
eps) Name
name of
Just TyThing
thing -> MaybeErr SDoc TyThing -> IfM lcl (MaybeErr SDoc TyThing)
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeErr SDoc TyThing -> IfM lcl (MaybeErr SDoc TyThing))
-> MaybeErr SDoc TyThing -> IfM lcl (MaybeErr SDoc TyThing)
forall a b. (a -> b) -> a -> b
$ TyThing -> MaybeErr SDoc TyThing
forall err val. val -> MaybeErr err val
Succeeded TyThing
thing
Maybe TyThing
Nothing -> let doc :: SDoc
doc = SDoc -> SDoc
whenPprDebug (ExternalPackageState -> SDoc
found_things_msg ExternalPackageState
eps SDoc -> SDoc -> SDoc
$$ SDoc
empty)
SDoc -> SDoc -> SDoc
$$ SDoc
not_found_msg
in MaybeErr SDoc TyThing -> IfM lcl (MaybeErr SDoc TyThing)
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeErr SDoc TyThing -> IfM lcl (MaybeErr SDoc TyThing))
-> MaybeErr SDoc TyThing -> IfM lcl (MaybeErr SDoc TyThing)
forall a b. (a -> b) -> a -> b
$ SDoc -> MaybeErr SDoc TyThing
forall err val. err -> MaybeErr err val
Failed SDoc
doc
}}}
where
nd_doc :: SDoc
nd_doc = String -> SDoc
text String
"Need decl for" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
not_found_msg :: SDoc
not_found_msg = SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Can't find interface-file declaration for" SDoc -> SDoc -> SDoc
<+>
NameSpace -> SDoc
pprNameSpace (Name -> NameSpace
nameNameSpace Name
name) SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
Int
2 ([SDoc] -> SDoc
vcat [String -> SDoc
text String
"Probable cause: bug in .hi-boot file, or inconsistent .hi file",
String -> SDoc
text String
"Use -ddump-if-trace to get an idea of which file caused the error"])
found_things_msg :: ExternalPackageState -> SDoc
found_things_msg ExternalPackageState
eps =
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Found the following declarations in" SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name) SDoc -> SDoc -> SDoc
<> SDoc
colon)
Int
2 ([SDoc] -> SDoc
vcat ((TyThing -> SDoc) -> [TyThing] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([TyThing] -> [SDoc]) -> [TyThing] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ (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]
nameEnvElts (TypeEnv -> [TyThing]) -> TypeEnv -> [TyThing]
forall a b. (a -> b) -> a -> b
$ ExternalPackageState -> TypeEnv
eps_PTE ExternalPackageState
eps))
where
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 (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise
= do { Module
mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; Logger
logger <- IOEnv (Env TcGblEnv TcLclEnv) Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
; IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> SDoc -> IO ()
trace_if Logger
logger DynFlags
dflags (String -> SDoc
text String
"checkWiredInTyCon" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc_name SDoc -> SDoc -> SDoc
$$ Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod)
; ASSERT( isExternalName tc_name )
Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
/= HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
tc_name)
(IfG () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. IfG a -> TcRn a
initIfaceTcRn (Name -> IfG ()
forall lcl. Name -> IfM lcl ()
loadWiredInHomeIface Name
tc_name))
}
where
tc_name :: Name
tc_name = TyCon -> Name
tyConName TyCon
tc
ifCheckWiredInThing :: TyThing -> IfL ()
ifCheckWiredInThing :: TyThing -> IfL ()
ifCheckWiredInThing TyThing
thing
= do { Module
mod <- IfL Module
getIfModule
; let name :: Name
name = TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
thing
; ASSERT2( isExternalName name, ppr name )
Bool -> IfL () -> IfL ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TyThing -> Bool
needWiredInHomeIface TyThing
thing Bool -> Bool -> Bool
&& Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
/= HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name)
(Name -> IfL ()
forall lcl. Name -> IfM lcl ()
loadWiredInHomeIface Name
name) }
needWiredInHomeIface :: TyThing -> Bool
needWiredInHomeIface :: TyThing -> Bool
needWiredInHomeIface (ATyCon {}) = Bool
True
needWiredInHomeIface TyThing
_ = Bool
False
loadSrcInterface :: SDoc
-> ModuleName
-> IsBootInterface
-> Maybe FastString
-> RnM ModIface
loadSrcInterface :: SDoc
-> ModuleName
-> IsBootInterface
-> Maybe FastString
-> RnM ModIface
loadSrcInterface SDoc
doc ModuleName
mod IsBootInterface
want_boot Maybe FastString
maybe_pkg
= do { MaybeErr SDoc ModIface
res <- SDoc
-> ModuleName
-> IsBootInterface
-> Maybe FastString
-> RnM (MaybeErr SDoc ModIface)
loadSrcInterface_maybe SDoc
doc ModuleName
mod IsBootInterface
want_boot Maybe FastString
maybe_pkg
; case MaybeErr SDoc ModIface
res of
Failed SDoc
err -> SDoc -> RnM ModIface
forall a. SDoc -> TcM a
failWithTc SDoc
err
Succeeded ModIface
iface -> ModIface -> RnM ModIface
forall (m :: * -> *) a. Monad m => a -> m a
return ModIface
iface }
loadSrcInterface_maybe :: SDoc
-> ModuleName
-> IsBootInterface
-> Maybe FastString
-> RnM (MaybeErr SDoc ModIface)
loadSrcInterface_maybe :: SDoc
-> ModuleName
-> IsBootInterface
-> Maybe FastString
-> RnM (MaybeErr SDoc ModIface)
loadSrcInterface_maybe SDoc
doc ModuleName
mod IsBootInterface
want_boot Maybe FastString
maybe_pkg
= do HscEnv
hsc_env <- TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
let fc :: FinderCache
fc = HscEnv -> FinderCache
hsc_FC HscEnv
hsc_env
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
let units :: UnitState
units = HscEnv -> UnitState
hsc_units HscEnv
hsc_env
let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
FindResult
res <- IO FindResult -> IOEnv (Env TcGblEnv TcLclEnv) FindResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FindResult -> IOEnv (Env TcGblEnv TcLclEnv) FindResult)
-> IO FindResult -> IOEnv (Env TcGblEnv TcLclEnv) FindResult
forall a b. (a -> b) -> a -> b
$ FinderCache
-> UnitState
-> HomeUnit
-> DynFlags
-> ModuleName
-> Maybe FastString
-> IO FindResult
findImportedModule FinderCache
fc UnitState
units HomeUnit
home_unit DynFlags
dflags ModuleName
mod Maybe FastString
maybe_pkg
case FindResult
res of
Found ModLocation
_ Module
mod -> IfG (MaybeErr SDoc ModIface) -> RnM (MaybeErr SDoc ModIface)
forall a. IfG a -> TcRn a
initIfaceTcRn (IfG (MaybeErr SDoc ModIface) -> RnM (MaybeErr SDoc ModIface))
-> IfG (MaybeErr SDoc ModIface) -> RnM (MaybeErr SDoc ModIface)
forall a b. (a -> b) -> a -> b
$ SDoc -> Module -> WhereFrom -> IfG (MaybeErr SDoc ModIface)
forall lcl.
SDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr SDoc ModIface)
loadInterface SDoc
doc Module
mod (IsBootInterface -> WhereFrom
ImportByUser IsBootInterface
want_boot)
FindResult
err -> MaybeErr SDoc ModIface -> RnM (MaybeErr SDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (SDoc -> MaybeErr SDoc ModIface
forall err val. err -> MaybeErr err val
Failed (HscEnv -> ModuleName -> FindResult -> SDoc
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 (t :: * -> *) a. Foldable t => t a -> Bool
null [Module]
mods = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
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
<+> SDoc -> SDoc
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 { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; MASSERT2( not (nameIsLocalOrFrom this_mod name), ppr name <+> parens doc ) }
; ASSERT2( isExternalName name, ppr name )
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) }
loadInterfaceForNameMaybe :: SDoc -> Name -> TcRn (Maybe ModIface)
loadInterfaceForNameMaybe :: SDoc -> Name -> TcRn (Maybe ModIface)
loadInterfaceForNameMaybe SDoc
doc Name
name
= do { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; if Module -> Name -> Bool
nameIsLocalOrFrom Module
this_mod Name
name Bool -> Bool -> Bool
|| Bool -> Bool
not (Name -> Bool
isExternalName Name
name)
then Maybe ModIface -> TcRn (Maybe ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ModIface
forall a. Maybe a
Nothing
else ModIface -> Maybe ModIface
forall a. a -> Maybe a
Just (ModIface -> Maybe ModIface)
-> RnM ModIface -> TcRn (Maybe ModIface)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
MASSERT2( 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 :: Name -> IfM lcl ()
loadWiredInHomeIface Name
name
= ASSERT( isWiredInName name )
do ModIface
_ <- SDoc -> Module -> IfM lcl ModIface
forall lcl. SDoc -> Module -> IfM lcl ModIface
loadSysInterface SDoc
doc (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name); () -> IfM lcl ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
doc :: SDoc
doc = String -> SDoc
text String
"Need home interface for wired-in thing" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
loadSysInterface :: 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 :: 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 :: 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 :: SDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException SDoc
doc Module
mod_name WhereFrom
where_from
= do
DynFlags
dflags <- IOEnv (Env IfGblEnv lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
DynFlags
-> IOEnv (Env IfGblEnv lcl) (MaybeErr SDoc ModIface)
-> IfM lcl ModIface
forall (m :: * -> *) a.
MonadIO m =>
DynFlags -> m (MaybeErr SDoc a) -> m a
withException DynFlags
dflags (SDoc
-> Module
-> WhereFrom
-> IOEnv (Env IfGblEnv lcl) (MaybeErr SDoc ModIface)
forall lcl.
SDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr SDoc ModIface)
loadInterface SDoc
doc Module
mod_name WhereFrom
where_from)
loadInterface :: SDoc -> Module -> WhereFrom
-> IfM lcl (MaybeErr SDoc ModIface)
loadInterface :: SDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr SDoc ModIface)
loadInterface SDoc
doc_str Module
mod WhereFrom
from
| Module -> Bool
forall u. GenModule (GenUnit u) -> Bool
isHoleModule Module
mod
= do HscEnv
hsc_env <- TcRnIf IfGblEnv lcl HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
SDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr SDoc ModIface)
forall lcl.
SDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr SDoc ModIface)
loadInterface SDoc
doc_str (HomeUnit -> ModuleName -> Module
mkHomeModule HomeUnit
home_unit (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod)) WhereFrom
from
| Bool
otherwise
= do
Logger
logger <- IOEnv (Env IfGblEnv lcl) Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
DynFlags
dflags <- IOEnv (Env IfGblEnv lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
Logger
-> DynFlags
-> SDoc
-> (MaybeErr SDoc ModIface -> ())
-> IfM lcl (MaybeErr SDoc ModIface)
-> IfM lcl (MaybeErr SDoc ModIface)
forall (m :: * -> *) a.
MonadIO m =>
Logger -> DynFlags -> SDoc -> (a -> ()) -> m a -> m a
withTimingSilent Logger
logger DynFlags
dflags (String -> SDoc
text String
"loading interface") (() -> MaybeErr SDoc ModIface -> ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (IfM lcl (MaybeErr SDoc ModIface)
-> IfM lcl (MaybeErr SDoc ModIface))
-> IfM lcl (MaybeErr SDoc ModIface)
-> IfM lcl (MaybeErr SDoc ModIface)
forall a b. (a -> b) -> a -> b
$ do
{
(ExternalPackageState
eps,HomePackageTable
hpt) <- TcRnIf IfGblEnv lcl (ExternalPackageState, HomePackageTable)
forall gbl lcl.
TcRnIf gbl lcl (ExternalPackageState, HomePackageTable)
getEpsAndHpt
; IfGblEnv
gbl_env <- TcRnIf IfGblEnv lcl IfGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
; DynFlags
dflags <- IOEnv (Env IfGblEnv lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; Logger
logger <- IOEnv (Env IfGblEnv lcl) Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
; IO () -> IOEnv (Env IfGblEnv lcl) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env IfGblEnv lcl) ())
-> IO () -> IOEnv (Env IfGblEnv lcl) ()
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> SDoc -> IO ()
trace_if Logger
logger DynFlags
dflags (String -> SDoc
text String
"Considering whether to load" SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
<+> WhereFrom -> SDoc
forall a. Outputable a => a -> SDoc
ppr WhereFrom
from)
; HscEnv
hsc_env <- TcRnIf IfGblEnv lcl HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
; let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
; case HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface
lookupIfaceByModule HomePackageTable
hpt (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) Module
mod of {
Just ModIface
iface
-> MaybeErr SDoc ModIface -> IfM lcl (MaybeErr SDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModIface -> MaybeErr SDoc ModIface
forall err val. val -> MaybeErr err val
Succeeded ModIface
iface) ;
Maybe ModIface
_ -> do {
; MaybeErr SDoc (ModIface, String)
read_result <- case (HomeUnit
-> ExternalPackageState
-> Module
-> WhereFrom
-> MaybeErr SDoc IsBootInterface
wantHiBootFile HomeUnit
home_unit ExternalPackageState
eps Module
mod WhereFrom
from) of
Failed SDoc
err -> MaybeErr SDoc (ModIface, String)
-> IOEnv (Env IfGblEnv lcl) (MaybeErr SDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (SDoc -> MaybeErr SDoc (ModIface, String)
forall err val. err -> MaybeErr err val
Failed SDoc
err)
Succeeded IsBootInterface
hi_boot_file -> do
HscEnv
hsc_env <- TcRnIf IfGblEnv lcl HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
IO (MaybeErr SDoc (ModIface, String))
-> IOEnv (Env IfGblEnv lcl) (MaybeErr SDoc (ModIface, String))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MaybeErr SDoc (ModIface, String))
-> IOEnv (Env IfGblEnv lcl) (MaybeErr SDoc (ModIface, String)))
-> IO (MaybeErr SDoc (ModIface, String))
-> IOEnv (Env IfGblEnv lcl) (MaybeErr SDoc (ModIface, String))
forall a b. (a -> b) -> a -> b
$ HscEnv
-> SDoc
-> IsBootInterface
-> Module
-> IO (MaybeErr SDoc (ModIface, String))
computeInterface HscEnv
hsc_env SDoc
doc_str IsBootInterface
hi_boot_file Module
mod
; case MaybeErr SDoc (ModIface, String)
read_result of {
Failed SDoc
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 :: PackageIfaceTable
eps_PIT = PackageIfaceTable -> Module -> ModIface -> PackageIfaceTable
forall a. ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
fake_iface) ModIface
fake_iface }
; MaybeErr SDoc ModIface -> IfM lcl (MaybeErr SDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (SDoc -> MaybeErr SDoc ModIface
forall err val. err -> MaybeErr err val
Failed SDoc
err) } ;
Succeeded (ModIface
iface, String
loc) ->
let
loc_doc :: SDoc
loc_doc = String -> SDoc
text String
loc
in
Module
-> SDoc
-> IsBootInterface
-> IfL (MaybeErr SDoc ModIface)
-> IfM lcl (MaybeErr SDoc 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 SDoc ModIface) -> IfM lcl (MaybeErr SDoc ModIface))
-> IfL (MaybeErr SDoc ModIface) -> IfM lcl (MaybeErr SDoc ModIface)
forall a b. (a -> b) -> a -> b
$
IfL (MaybeErr SDoc ModIface) -> IfL (MaybeErr SDoc ModIface)
forall a. IfL a -> IfL a
dontLeakTheHPT (IfL (MaybeErr SDoc ModIface) -> IfL (MaybeErr SDoc ModIface))
-> IfL (MaybeErr SDoc ModIface) -> IfL (MaybeErr SDoc ModIface)
forall a b. (a -> b) -> a -> b
$ do
; Bool
ignore_prags <- GeneralFlag -> TcRnIf IfGblEnv IfLclEnv Bool
forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
goptM GeneralFlag
Opt_IgnoreInterfacePragmas
; [(Name, TyThing)]
new_eps_decls <- Bool -> [(Fingerprint, IfaceDecl)] -> IfL [(Name, TyThing)]
tcIfaceDecls Bool
ignore_prags (ModIface -> [IfaceDeclExts 'ModIfaceFinal]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls ModIface
iface)
; [ClsInst]
new_eps_insts <- (IfaceClsInst -> IOEnv (Env IfGblEnv IfLclEnv) ClsInst)
-> [IfaceClsInst] -> IOEnv (Env IfGblEnv IfLclEnv) [ClsInst]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceClsInst -> IOEnv (Env IfGblEnv IfLclEnv) ClsInst
tcIfaceInst (ModIface -> [IfaceClsInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts ModIface
iface)
; [FamInst]
new_eps_fam_insts <- (IfaceFamInst -> IOEnv (Env IfGblEnv IfLclEnv) FamInst)
-> [IfaceFamInst] -> IOEnv (Env IfGblEnv IfLclEnv) [FamInst]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceFamInst -> IOEnv (Env IfGblEnv IfLclEnv) FamInst
tcIfaceFamInst (ModIface -> [IfaceFamInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts ModIface
iface)
; [CoreRule]
new_eps_rules <- Bool -> [IfaceRule] -> IfL [CoreRule]
tcIfaceRules Bool
ignore_prags (ModIface -> [IfaceRule]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules ModIface
iface)
; [Annotation]
new_eps_anns <- [IfaceAnnotation] -> IfL [Annotation]
tcIfaceAnnotations (ModIface -> [IfaceAnnotation]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns ModIface
iface)
; [CompleteMatch]
new_eps_complete_matches <- [IfaceCompleteMatch] -> IfL [CompleteMatch]
tcIfaceCompleteMatches (ModIface -> [IfaceCompleteMatch]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_matches ModIface
iface)
; let { final_iface :: ModIface
final_iface = ModIface
iface {
mi_decls :: [IfaceDeclExts 'ModIfaceFinal]
mi_decls = String -> [(Fingerprint, IfaceDecl)]
forall a. String -> a
panic String
"No mi_decls in PIT",
mi_insts :: [IfaceClsInst]
mi_insts = String -> [IfaceClsInst]
forall a. String -> a
panic String
"No mi_insts in PIT",
mi_fam_insts :: [IfaceFamInst]
mi_fam_insts = String -> [IfaceFamInst]
forall a. String -> a
panic String
"No mi_fam_insts in PIT",
mi_rules :: [IfaceRule]
mi_rules = String -> [IfaceRule]
forall a. String -> a
panic String
"No mi_rules in PIT",
mi_anns :: [IfaceAnnotation]
mi_anns = String -> [IfaceAnnotation]
forall a. String -> a
panic String
"No mi_anns in PIT"
}
}
; let bad_boot :: Bool
bad_boot = ModIface -> IsBootInterface
mi_boot ModIface
iface IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot Bool -> Bool -> Bool
&& ((Module, IfG TypeEnv) -> Module)
-> Maybe (Module, IfG TypeEnv) -> Maybe Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Module, IfG TypeEnv) -> Module
forall a b. (a, b) -> a
fst (IfGblEnv -> Maybe (Module, IfG TypeEnv)
if_rec_types IfGblEnv
gbl_env) Maybe Module -> Maybe Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> Maybe Module
forall a. a -> Maybe a
Just Module
mod
; WARN( bad_boot, ppr mod )
(ExternalPackageState -> ExternalPackageState) -> IfL ()
forall gbl lcl.
(ExternalPackageState -> ExternalPackageState) -> TcRnIf gbl lcl ()
updateEps_ ((ExternalPackageState -> ExternalPackageState) -> IfL ())
-> (ExternalPackageState -> ExternalPackageState) -> IfL ()
forall a b. (a -> b) -> a -> b
$ \ ExternalPackageState
eps ->
if Module -> PackageIfaceTable -> Bool
forall a. Module -> ModuleEnv a -> Bool
elemModuleEnv Module
mod (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) Bool -> Bool -> Bool
|| HomeUnit -> ModIface -> Bool
is_external_sig HomeUnit
home_unit ModIface
iface
then ExternalPackageState
eps
else if Bool
bad_boot
then ExternalPackageState
eps { eps_PTE :: TypeEnv
eps_PTE = TypeEnv -> [(Name, TyThing)] -> TypeEnv
addDeclsToPTE (ExternalPackageState -> TypeEnv
eps_PTE ExternalPackageState
eps) [(Name, TyThing)]
new_eps_decls }
else
ExternalPackageState
eps {
eps_PIT :: PackageIfaceTable
eps_PIT = PackageIfaceTable -> Module -> ModIface -> PackageIfaceTable
forall a. ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) Module
mod ModIface
final_iface,
eps_PTE :: TypeEnv
eps_PTE = TypeEnv -> [(Name, TyThing)] -> TypeEnv
addDeclsToPTE (ExternalPackageState -> TypeEnv
eps_PTE ExternalPackageState
eps) [(Name, TyThing)]
new_eps_decls,
eps_rule_base :: PackageRuleBase
eps_rule_base = PackageRuleBase -> [CoreRule] -> PackageRuleBase
extendRuleBaseList (ExternalPackageState -> PackageRuleBase
eps_rule_base ExternalPackageState
eps)
[CoreRule]
new_eps_rules,
eps_complete_matches :: [CompleteMatch]
eps_complete_matches
= ExternalPackageState -> [CompleteMatch]
eps_complete_matches ExternalPackageState
eps [CompleteMatch] -> [CompleteMatch] -> [CompleteMatch]
forall a. [a] -> [a] -> [a]
++ [CompleteMatch]
new_eps_complete_matches,
eps_inst_env :: PackageInstEnv
eps_inst_env = PackageInstEnv -> [ClsInst] -> PackageInstEnv
extendInstEnvList (ExternalPackageState -> PackageInstEnv
eps_inst_env ExternalPackageState
eps)
[ClsInst]
new_eps_insts,
eps_fam_inst_env :: PackageFamInstEnv
eps_fam_inst_env = PackageFamInstEnv -> [FamInst] -> PackageFamInstEnv
extendFamInstEnvList (ExternalPackageState -> PackageFamInstEnv
eps_fam_inst_env ExternalPackageState
eps)
[FamInst]
new_eps_fam_insts,
eps_ann_env :: PackageAnnEnv
eps_ann_env = PackageAnnEnv -> [Annotation] -> PackageAnnEnv
extendAnnEnvList (ExternalPackageState -> PackageAnnEnv
eps_ann_env ExternalPackageState
eps)
[Annotation]
new_eps_anns,
eps_mod_fam_inst_env :: ModuleEnv PackageFamInstEnv
eps_mod_fam_inst_env
= let
fam_inst_env :: PackageFamInstEnv
fam_inst_env =
PackageFamInstEnv -> [FamInst] -> PackageFamInstEnv
extendFamInstEnvList PackageFamInstEnv
emptyFamInstEnv
[FamInst]
new_eps_fam_insts
in
ModuleEnv PackageFamInstEnv
-> Module -> PackageFamInstEnv -> ModuleEnv PackageFamInstEnv
forall a. ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv (ExternalPackageState -> ModuleEnv PackageFamInstEnv
eps_mod_fam_inst_env ExternalPackageState
eps)
Module
mod
PackageFamInstEnv
fam_inst_env,
eps_stats :: EpsStats
eps_stats = EpsStats -> Int -> Int -> Int -> EpsStats
addEpsInStats (ExternalPackageState -> EpsStats
eps_stats ExternalPackageState
eps)
([(Name, TyThing)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Name, TyThing)]
new_eps_decls)
([ClsInst] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ClsInst]
new_eps_insts)
([CoreRule] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CoreRule]
new_eps_rules) }
;
ModIface
res <- HscEnv
-> PluginOperation (IOEnv (Env IfGblEnv IfLclEnv)) ModIface
-> ModIface
-> IOEnv (Env IfGblEnv IfLclEnv) ModIface
forall (m :: * -> *) a.
Monad m =>
HscEnv -> PluginOperation m a -> a -> m a
withPlugins HscEnv
hsc_env (\Plugin
p -> Plugin -> forall lcl. [String] -> ModIface -> IfM lcl ModIface
interfaceLoadAction Plugin
p) ModIface
iface
; MaybeErr SDoc ModIface -> IfL (MaybeErr SDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModIface -> MaybeErr SDoc ModIface
forall err val. val -> MaybeErr err val
Succeeded ModIface
res)
}}}}
dontLeakTheHPT :: IfL a -> IfL a
dontLeakTheHPT :: IfL a -> IfL a
dontLeakTheHPT IfL a
thing_inside = do
let
cleanTopEnv :: HscEnv -> HscEnv
cleanTopEnv HscEnv{[Target]
[LoadedPlugin]
[StaticPlugin]
Maybe [UnitDatabase UnitId]
Maybe (Module, IORef TypeEnv)
Maybe Interp
IORef ExternalPackageState
DynFlags
HomePackageTable
Logger
ModuleGraph
InteractiveContext
NameCache
FinderCache
UnitEnv
Hooks
TmpFs
hsc_unit_env :: HscEnv -> UnitEnv
hsc_unit_dbs :: HscEnv -> Maybe [UnitDatabase UnitId]
hsc_type_env_var :: HscEnv -> Maybe (Module, IORef TypeEnv)
hsc_tmpfs :: HscEnv -> TmpFs
hsc_targets :: HscEnv -> [Target]
hsc_static_plugins :: HscEnv -> [StaticPlugin]
hsc_plugins :: HscEnv -> [LoadedPlugin]
hsc_mod_graph :: HscEnv -> ModuleGraph
hsc_logger :: HscEnv -> Logger
hsc_interp :: HscEnv -> Maybe Interp
hsc_hooks :: HscEnv -> Hooks
hsc_NC :: HscEnv -> NameCache
hsc_IC :: HscEnv -> InteractiveContext
hsc_HPT :: HscEnv -> HomePackageTable
hsc_EPS :: HscEnv -> IORef ExternalPackageState
hsc_tmpfs :: TmpFs
hsc_hooks :: Hooks
hsc_logger :: Logger
hsc_unit_env :: UnitEnv
hsc_unit_dbs :: Maybe [UnitDatabase UnitId]
hsc_static_plugins :: [StaticPlugin]
hsc_plugins :: [LoadedPlugin]
hsc_interp :: Maybe Interp
hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
hsc_FC :: FinderCache
hsc_NC :: NameCache
hsc_EPS :: IORef ExternalPackageState
hsc_HPT :: HomePackageTable
hsc_IC :: InteractiveContext
hsc_mod_graph :: ModuleGraph
hsc_targets :: [Target]
hsc_dflags :: DynFlags
hsc_dflags :: HscEnv -> DynFlags
hsc_FC :: HscEnv -> FinderCache
..} =
let
!hpt :: HomePackageTable
hpt | DynFlags -> Backend
backend DynFlags
hsc_dflags Backend -> Backend -> Bool
forall a. Eq a => a -> a -> Bool
== Backend
NoBackend = HomePackageTable
hsc_HPT
| Bool
otherwise = HomePackageTable
emptyHomePackageTable
in
HscEnv :: DynFlags
-> [Target]
-> ModuleGraph
-> InteractiveContext
-> HomePackageTable
-> IORef ExternalPackageState
-> NameCache
-> FinderCache
-> Maybe (Module, IORef TypeEnv)
-> Maybe Interp
-> [LoadedPlugin]
-> [StaticPlugin]
-> Maybe [UnitDatabase UnitId]
-> UnitEnv
-> Logger
-> Hooks
-> TmpFs
-> HscEnv
HscEnv { hsc_targets :: [Target]
hsc_targets = String -> [Target]
forall a. String -> a
panic String
"cleanTopEnv: hsc_targets"
, hsc_mod_graph :: ModuleGraph
hsc_mod_graph = String -> ModuleGraph
forall a. String -> a
panic String
"cleanTopEnv: hsc_mod_graph"
, hsc_IC :: InteractiveContext
hsc_IC = String -> InteractiveContext
forall a. String -> a
panic String
"cleanTopEnv: hsc_IC"
, hsc_HPT :: HomePackageTable
hsc_HPT = HomePackageTable
hpt
, [LoadedPlugin]
[StaticPlugin]
Maybe [UnitDatabase UnitId]
Maybe (Module, IORef TypeEnv)
Maybe Interp
IORef ExternalPackageState
DynFlags
Logger
NameCache
FinderCache
UnitEnv
Hooks
TmpFs
hsc_unit_env :: UnitEnv
hsc_unit_dbs :: Maybe [UnitDatabase UnitId]
hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
hsc_tmpfs :: TmpFs
hsc_static_plugins :: [StaticPlugin]
hsc_plugins :: [LoadedPlugin]
hsc_logger :: Logger
hsc_interp :: Maybe Interp
hsc_hooks :: Hooks
hsc_NC :: NameCache
hsc_EPS :: IORef ExternalPackageState
hsc_tmpfs :: TmpFs
hsc_hooks :: Hooks
hsc_logger :: Logger
hsc_unit_env :: UnitEnv
hsc_unit_dbs :: Maybe [UnitDatabase UnitId]
hsc_static_plugins :: [StaticPlugin]
hsc_plugins :: [LoadedPlugin]
hsc_interp :: Maybe Interp
hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
hsc_FC :: FinderCache
hsc_NC :: NameCache
hsc_EPS :: IORef ExternalPackageState
hsc_dflags :: DynFlags
hsc_dflags :: DynFlags
hsc_FC :: FinderCache
.. }
(HscEnv -> HscEnv) -> IfL a -> IfL a
forall gbl lcl a.
(HscEnv -> HscEnv) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
updTopEnv HscEnv -> HscEnv
cleanTopEnv (IfL a -> IfL a) -> IfL a -> IfL a
forall a b. (a -> b) -> a -> b
$ do
!HscEnv
_ <- TcRnIf IfGblEnv IfLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
IfL a
thing_inside
is_external_sig :: HomeUnit -> ModIface -> Bool
is_external_sig :: HomeUnit -> ModIface -> Bool
is_external_sig HomeUnit
home_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
&&
Bool -> Bool
not (HomeUnit -> Module -> Bool
isHomeModule HomeUnit
home_unit (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface))
computeInterface
:: HscEnv
-> SDoc
-> IsBootInterface
-> Module
-> IO (MaybeErr SDoc (ModIface, FilePath))
computeInterface :: HscEnv
-> SDoc
-> IsBootInterface
-> Module
-> IO (MaybeErr SDoc (ModIface, String))
computeInterface HscEnv
hsc_env SDoc
doc_str IsBootInterface
hi_boot_file Module
mod0 = do
MASSERT( not (isHoleModule mod0) )
let name_cache :: NameCache
name_cache = HscEnv -> NameCache
hsc_NC HscEnv
hsc_env
let fc :: FinderCache
fc = HscEnv -> FinderCache
hsc_FC HscEnv
hsc_env
let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
let units :: UnitState
units = HscEnv -> UnitState
hsc_units HscEnv
hsc_env
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
let logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
let hooks :: Hooks
hooks = HscEnv -> Hooks
hsc_hooks HscEnv
hsc_env
let find_iface :: InstalledModule -> IO (MaybeErr SDoc (ModIface, String))
find_iface InstalledModule
m = Logger
-> NameCache
-> FinderCache
-> Hooks
-> UnitState
-> HomeUnit
-> DynFlags
-> SDoc
-> InstalledModule
-> Module
-> IsBootInterface
-> IO (MaybeErr SDoc (ModIface, String))
findAndReadIface Logger
logger NameCache
name_cache FinderCache
fc Hooks
hooks UnitState
units HomeUnit
home_unit DynFlags
dflags SDoc
doc_str
InstalledModule
m Module
mod0 IsBootInterface
hi_boot_file
case Module -> (InstalledModule, Maybe InstantiatedModule)
getModuleInstantiation Module
mod0 of
(InstalledModule
imod, Just InstantiatedModule
indef) | HomeUnit -> Bool
forall u. GenHomeUnit u -> Bool
isHomeUnitIndefinite HomeUnit
home_unit ->
InstalledModule -> IO (MaybeErr SDoc (ModIface, String))
find_iface InstalledModule
imod IO (MaybeErr SDoc (ModIface, String))
-> (MaybeErr SDoc (ModIface, String)
-> IO (MaybeErr SDoc (ModIface, String)))
-> IO (MaybeErr SDoc (ModIface, String))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Succeeded (ModIface
iface0, String
path) ->
HscEnv
-> [(ModuleName, Module)]
-> Maybe NameShape
-> ModIface
-> IO (Either ErrorMessages 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 ErrorMessages ModIface)
-> (Either ErrorMessages ModIface
-> IO (MaybeErr SDoc (ModIface, String)))
-> IO (MaybeErr SDoc (ModIface, String))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right ModIface
x -> MaybeErr SDoc (ModIface, String)
-> IO (MaybeErr SDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return ((ModIface, String) -> MaybeErr SDoc (ModIface, String)
forall err val. val -> MaybeErr err val
Succeeded (ModIface
x, String
path))
Left ErrorMessages
errs -> SourceError -> IO (MaybeErr SDoc (ModIface, String))
forall e a. Exception e => e -> IO a
throwIO (SourceError -> IO (MaybeErr SDoc (ModIface, String)))
-> (ErrorMessages -> SourceError)
-> ErrorMessages
-> IO (MaybeErr SDoc (ModIface, String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessages -> SourceError
mkSrcErr (ErrorMessages -> IO (MaybeErr SDoc (ModIface, String)))
-> ErrorMessages -> IO (MaybeErr SDoc (ModIface, String))
forall a b. (a -> b) -> a -> b
$ ErrorMessages
errs
Failed SDoc
err -> MaybeErr SDoc (ModIface, String)
-> IO (MaybeErr SDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (SDoc -> MaybeErr SDoc (ModIface, String)
forall err val. err -> MaybeErr err val
Failed SDoc
err)
(InstalledModule
mod, Maybe InstantiatedModule
_) -> InstalledModule -> IO (MaybeErr SDoc (ModIface, String))
find_iface InstalledModule
mod
moduleFreeHolesPrecise
:: SDoc -> Module
-> TcRnIf gbl lcl (MaybeErr SDoc (UniqDSet ModuleName))
moduleFreeHolesPrecise :: SDoc
-> Module -> TcRnIf gbl lcl (MaybeErr SDoc (UniqDSet ModuleName))
moduleFreeHolesPrecise SDoc
doc_str Module
mod
| Module -> Bool
moduleIsDefinite Module
mod = MaybeErr SDoc (UniqDSet ModuleName)
-> TcRnIf gbl lcl (MaybeErr SDoc (UniqDSet ModuleName))
forall (m :: * -> *) a. Monad m => a -> m a
return (UniqDSet ModuleName -> MaybeErr SDoc (UniqDSet ModuleName)
forall err val. val -> MaybeErr err val
Succeeded UniqDSet ModuleName
forall a. UniqDSet a
emptyUniqDSet)
| Bool
otherwise =
case Module -> (InstalledModule, Maybe InstantiatedModule)
getModuleInstantiation Module
mod of
(InstalledModule
imod, Just InstantiatedModule
indef) -> do
DynFlags
dflags <- IOEnv (Env gbl lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
Logger
logger <- IOEnv (Env gbl lcl) Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
let insts :: [(ModuleName, Module)]
insts = GenInstantiatedUnit UnitId -> [(ModuleName, Module)]
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts (InstantiatedModule -> GenInstantiatedUnit UnitId
forall unit. GenModule unit -> unit
moduleUnit InstantiatedModule
indef)
IO () -> IOEnv (Env gbl lcl) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env gbl lcl) ())
-> IO () -> IOEnv (Env gbl lcl) ()
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> SDoc -> IO ()
trace_if Logger
logger DynFlags
dflags (String -> SDoc
text String
"Considering whether to load" SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"to compute precise free module holes")
(ExternalPackageState
eps, HomePackageTable
hpt) <- TcRnIf gbl lcl (ExternalPackageState, HomePackageTable)
forall gbl lcl.
TcRnIf gbl lcl (ExternalPackageState, HomePackageTable)
getEpsAndHpt
case ExternalPackageState
-> HomePackageTable -> Maybe (UniqDSet ModuleName)
tryEpsAndHpt ExternalPackageState
eps HomePackageTable
hpt Maybe (UniqDSet ModuleName)
-> Maybe (UniqDSet ModuleName) -> Maybe (UniqDSet ModuleName)
forall a. Maybe a -> Maybe a -> Maybe a
`firstJust` ExternalPackageState
-> InstalledModule
-> [(ModuleName, Module)]
-> Maybe (UniqDSet ModuleName)
tryDepsCache ExternalPackageState
eps InstalledModule
imod [(ModuleName, Module)]
insts of
Just UniqDSet ModuleName
r -> MaybeErr SDoc (UniqDSet ModuleName)
-> TcRnIf gbl lcl (MaybeErr SDoc (UniqDSet ModuleName))
forall (m :: * -> *) a. Monad m => a -> m a
return (UniqDSet ModuleName -> MaybeErr SDoc (UniqDSet ModuleName)
forall err val. val -> MaybeErr err val
Succeeded UniqDSet ModuleName
r)
Maybe (UniqDSet ModuleName)
Nothing -> InstalledModule
-> [(ModuleName, Module)]
-> TcRnIf gbl lcl (MaybeErr SDoc (UniqDSet ModuleName))
readAndCache InstalledModule
imod [(ModuleName, Module)]
insts
(InstalledModule
_, Maybe InstantiatedModule
Nothing) -> MaybeErr SDoc (UniqDSet ModuleName)
-> TcRnIf gbl lcl (MaybeErr SDoc (UniqDSet ModuleName))
forall (m :: * -> *) a. Monad m => a -> m a
return (UniqDSet ModuleName -> MaybeErr SDoc (UniqDSet ModuleName)
forall err val. val -> MaybeErr err val
Succeeded UniqDSet ModuleName
forall a. UniqDSet a
emptyUniqDSet)
where
tryEpsAndHpt :: ExternalPackageState
-> HomePackageTable -> Maybe (UniqDSet ModuleName)
tryEpsAndHpt ExternalPackageState
eps HomePackageTable
hpt =
(ModIface -> UniqDSet ModuleName)
-> Maybe ModIface -> Maybe (UniqDSet ModuleName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModIface -> UniqDSet ModuleName
mi_free_holes (HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface
lookupIfaceByModule HomePackageTable
hpt (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) Module
mod)
tryDepsCache :: ExternalPackageState
-> InstalledModule
-> [(ModuleName, Module)]
-> Maybe (UniqDSet ModuleName)
tryDepsCache ExternalPackageState
eps InstalledModule
imod [(ModuleName, Module)]
insts =
case InstalledModuleEnv (UniqDSet ModuleName)
-> InstalledModule -> Maybe (UniqDSet ModuleName)
forall a. InstalledModuleEnv a -> InstalledModule -> Maybe a
lookupInstalledModuleEnv (ExternalPackageState -> InstalledModuleEnv (UniqDSet ModuleName)
eps_free_holes ExternalPackageState
eps) InstalledModule
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 :: InstalledModule
-> [(ModuleName, Module)]
-> TcRnIf gbl lcl (MaybeErr SDoc (UniqDSet ModuleName))
readAndCache InstalledModule
imod [(ModuleName, Module)]
insts = do
HscEnv
hsc_env <- TcRnIf gbl lcl HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
let nc :: NameCache
nc = HscEnv -> NameCache
hsc_NC HscEnv
hsc_env
let fc :: FinderCache
fc = HscEnv -> FinderCache
hsc_FC HscEnv
hsc_env
let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
let units :: UnitState
units = HscEnv -> UnitState
hsc_units HscEnv
hsc_env
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
let logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
let hooks :: Hooks
hooks = HscEnv -> Hooks
hsc_hooks HscEnv
hsc_env
MaybeErr SDoc (ModIface, String)
mb_iface <- IO (MaybeErr SDoc (ModIface, String))
-> IOEnv (Env gbl lcl) (MaybeErr SDoc (ModIface, String))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MaybeErr SDoc (ModIface, String))
-> IOEnv (Env gbl lcl) (MaybeErr SDoc (ModIface, String)))
-> IO (MaybeErr SDoc (ModIface, String))
-> IOEnv (Env gbl lcl) (MaybeErr SDoc (ModIface, String))
forall a b. (a -> b) -> a -> b
$ Logger
-> NameCache
-> FinderCache
-> Hooks
-> UnitState
-> HomeUnit
-> DynFlags
-> SDoc
-> InstalledModule
-> Module
-> IsBootInterface
-> IO (MaybeErr SDoc (ModIface, String))
findAndReadIface Logger
logger NameCache
nc FinderCache
fc Hooks
hooks UnitState
units HomeUnit
home_unit DynFlags
dflags
(String -> SDoc
text String
"moduleFreeHolesPrecise" SDoc -> SDoc -> SDoc
<+> SDoc
doc_str)
InstalledModule
imod Module
mod IsBootInterface
NotBoot
case MaybeErr SDoc (ModIface, String)
mb_iface of
Succeeded (ModIface
iface, String
_) -> 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 :: InstalledModuleEnv (UniqDSet ModuleName)
eps_free_holes = InstalledModuleEnv (UniqDSet ModuleName)
-> InstalledModule
-> UniqDSet ModuleName
-> InstalledModuleEnv (UniqDSet ModuleName)
forall a.
InstalledModuleEnv a
-> InstalledModule -> a -> InstalledModuleEnv a
extendInstalledModuleEnv (ExternalPackageState -> InstalledModuleEnv (UniqDSet ModuleName)
eps_free_holes ExternalPackageState
eps) InstalledModule
imod UniqDSet ModuleName
ifhs })
MaybeErr SDoc (UniqDSet ModuleName)
-> TcRnIf gbl lcl (MaybeErr SDoc (UniqDSet ModuleName))
forall (m :: * -> *) a. Monad m => a -> m a
return (UniqDSet ModuleName -> MaybeErr SDoc (UniqDSet ModuleName)
forall err val. val -> MaybeErr err val
Succeeded (UniqDSet ModuleName
-> [(ModuleName, Module)] -> UniqDSet ModuleName
renameFreeHoles UniqDSet ModuleName
ifhs [(ModuleName, Module)]
insts))
Failed SDoc
err -> MaybeErr SDoc (UniqDSet ModuleName)
-> TcRnIf gbl lcl (MaybeErr SDoc (UniqDSet ModuleName))
forall (m :: * -> *) a. Monad m => a -> m a
return (SDoc -> MaybeErr SDoc (UniqDSet ModuleName)
forall err val. err -> MaybeErr err val
Failed SDoc
err)
wantHiBootFile :: HomeUnit -> ExternalPackageState -> Module -> WhereFrom
-> MaybeErr SDoc IsBootInterface
wantHiBootFile :: HomeUnit
-> ExternalPackageState
-> Module
-> WhereFrom
-> MaybeErr SDoc IsBootInterface
wantHiBootFile HomeUnit
home_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
&& HomeUnit -> Module -> Bool
notHomeModule HomeUnit
home_unit Module
mod
-> SDoc -> MaybeErr SDoc IsBootInterface
forall err val. err -> MaybeErr err val
Failed (Module -> SDoc
badSourceImport Module
mod)
| Bool
otherwise -> IsBootInterface -> MaybeErr SDoc IsBootInterface
forall err val. val -> MaybeErr err val
Succeeded IsBootInterface
usr_boot
WhereFrom
ImportByPlugin
-> IsBootInterface -> MaybeErr SDoc IsBootInterface
forall err val. val -> MaybeErr err val
Succeeded IsBootInterface
NotBoot
WhereFrom
ImportBySystem
| HomeUnit -> Module -> Bool
notHomeModule HomeUnit
home_unit Module
mod
-> IsBootInterface -> MaybeErr SDoc IsBootInterface
forall err val. val -> MaybeErr err val
Succeeded IsBootInterface
NotBoot
| Bool
otherwise
-> case UniqFM ModuleName ModuleNameWithIsBoot
-> ModuleName -> Maybe ModuleNameWithIsBoot
forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM (ExternalPackageState -> UniqFM ModuleName ModuleNameWithIsBoot
eps_is_boot ExternalPackageState
eps) (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod) of
Just (GWIB { gwib_isBoot :: forall mod. GenWithIsBoot mod -> IsBootInterface
gwib_isBoot = IsBootInterface
is_boot }) ->
IsBootInterface -> MaybeErr SDoc IsBootInterface
forall err val. val -> MaybeErr err val
Succeeded IsBootInterface
is_boot
Maybe ModuleNameWithIsBoot
Nothing ->
IsBootInterface -> MaybeErr SDoc IsBootInterface
forall err val. val -> MaybeErr err val
Succeeded IsBootInterface
NotBoot
badSourceImport :: Module -> SDoc
badSourceImport :: Module -> SDoc
badSourceImport Module
mod
= SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"You cannot {-# SOURCE #-} import a module from another package")
Int
2 (String -> SDoc
text String
"but" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod) SDoc -> SDoc -> SDoc
<+> PtrString -> SDoc
ptext (String -> PtrString
sLit String
"is from package")
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod)))
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
:: Logger
-> NameCache
-> FinderCache
-> Hooks
-> UnitState
-> HomeUnit
-> DynFlags
-> SDoc
-> InstalledModule
-> Module
-> IsBootInterface
-> IO (MaybeErr SDoc (ModIface, FilePath))
findAndReadIface :: Logger
-> NameCache
-> FinderCache
-> Hooks
-> UnitState
-> HomeUnit
-> DynFlags
-> SDoc
-> InstalledModule
-> Module
-> IsBootInterface
-> IO (MaybeErr SDoc (ModIface, String))
findAndReadIface Logger
logger NameCache
name_cache FinderCache
fc Hooks
hooks UnitState
unit_state HomeUnit
home_unit DynFlags
dflags SDoc
doc_str InstalledModule
mod Module
wanted_mod IsBootInterface
hi_boot_file = do
let profile :: Profile
profile = DynFlags -> Profile
targetProfile DynFlags
dflags
Logger -> DynFlags -> SDoc -> IO ()
trace_if Logger
logger DynFlags
dflags ([SDoc] -> SDoc
sep [[SDoc] -> SDoc
hsep [String -> SDoc
text String
"Reading",
if IsBootInterface
hi_boot_file IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot
then String -> SDoc
text String
"[boot]"
else SDoc
Outputable.empty,
String -> SDoc
text String
"interface for",
InstalledModule -> SDoc
forall a. Outputable a => a -> SDoc
ppr InstalledModule
mod SDoc -> SDoc -> SDoc
<> SDoc
semi],
Int -> SDoc -> SDoc
nest Int
4 (String -> SDoc
text String
"reason:" SDoc -> SDoc -> SDoc
<+> SDoc
doc_str)])
if InstalledModule
mod InstalledModule -> 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 SDoc (ModIface, String)
-> IO (MaybeErr SDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return ((ModIface, String) -> MaybeErr SDoc (ModIface, String)
forall err val. val -> MaybeErr err val
Succeeded (ModIface
iface, String
"<built in interface for GHC.Prim>"))
else do
InstalledFindResult
mb_found <- IO InstalledFindResult -> IO InstalledFindResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FinderCache
-> DynFlags
-> UnitState
-> HomeUnit
-> InstalledModule
-> IO InstalledFindResult
findExactModule FinderCache
fc DynFlags
dflags UnitState
unit_state HomeUnit
home_unit InstalledModule
mod)
case InstalledFindResult
mb_found of
InstalledFound ModLocation
loc InstalledModule
mod -> do
let file_path :: String
file_path = IsBootInterface -> String -> String
addBootSuffix_maybe IsBootInterface
hi_boot_file (ModLocation -> String
ml_hi_file ModLocation
loc)
if HomeUnit -> InstalledModule -> Bool
forall u. GenHomeUnit u -> InstalledModule -> Bool
isHomeInstalledModule HomeUnit
home_unit InstalledModule
mod Bool -> Bool -> Bool
&&
Bool -> Bool
not (GhcMode -> Bool
isOneShot (DynFlags -> GhcMode
ghcMode DynFlags
dflags))
then MaybeErr SDoc (ModIface, String)
-> IO (MaybeErr SDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (SDoc -> MaybeErr SDoc (ModIface, String)
forall err val. err -> MaybeErr err val
Failed (InstalledModule -> ModLocation -> SDoc
homeModError InstalledModule
mod ModLocation
loc))
else do
MaybeErr SDoc (ModIface, String)
r <- Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> String
-> IO (MaybeErr SDoc (ModIface, String))
read_file Logger
logger NameCache
name_cache UnitState
unit_state DynFlags
dflags Module
wanted_mod String
file_path
case MaybeErr SDoc (ModIface, String)
r of
Failed SDoc
_
-> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Succeeded (ModIface
iface,String
fp)
-> Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> IsBootInterface
-> ModIface
-> String
-> IO ()
load_dynamic_too_maybe Logger
logger NameCache
name_cache UnitState
unit_state
DynFlags
dflags Module
wanted_mod
IsBootInterface
hi_boot_file ModIface
iface String
fp
MaybeErr SDoc (ModIface, String)
-> IO (MaybeErr SDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return MaybeErr SDoc (ModIface, String)
r
InstalledFindResult
err -> do
Logger -> DynFlags -> SDoc -> IO ()
trace_if Logger
logger DynFlags
dflags (String -> SDoc
text String
"...not found")
MaybeErr SDoc (ModIface, String)
-> IO (MaybeErr SDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeErr SDoc (ModIface, String)
-> IO (MaybeErr SDoc (ModIface, String)))
-> MaybeErr SDoc (ModIface, String)
-> IO (MaybeErr SDoc (ModIface, String))
forall a b. (a -> b) -> a -> b
$ SDoc -> MaybeErr SDoc (ModIface, String)
forall err val. err -> MaybeErr err val
Failed (SDoc -> MaybeErr SDoc (ModIface, String))
-> SDoc -> MaybeErr SDoc (ModIface, String)
forall a b. (a -> b) -> a -> b
$ UnitState
-> HomeUnit
-> Profile
-> ([String] -> SDoc)
-> ModuleName
-> InstalledFindResult
-> SDoc
cannotFindInterface
UnitState
unit_state
HomeUnit
home_unit
Profile
profile
(DynFlags -> [String] -> SDoc
may_show_locations DynFlags
dflags)
(InstalledModule -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName InstalledModule
mod)
InstalledFindResult
err
load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> IsBootInterface -> ModIface -> FilePath -> IO ()
load_dynamic_too_maybe :: Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> IsBootInterface
-> ModIface
-> String
-> IO ()
load_dynamic_too_maybe Logger
logger NameCache
name_cache UnitState
unit_state DynFlags
dflags Module
wanted_mod IsBootInterface
is_boot ModIface
iface String
file_path
| Bool -> Bool
not (Module -> Bool
moduleIsDefinite (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface)) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = DynFlags -> IO DynamicTooState
forall (m :: * -> *). MonadIO m => DynFlags -> m DynamicTooState
dynamicTooState DynFlags
dflags IO DynamicTooState -> (DynamicTooState -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
DynamicTooState
DT_Dont -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DynamicTooState
DT_Failed -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
DynamicTooState
DT_Dyn -> Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> IsBootInterface
-> ModIface
-> String
-> IO ()
load_dynamic_too Logger
logger NameCache
name_cache UnitState
unit_state DynFlags
dflags Module
wanted_mod IsBootInterface
is_boot ModIface
iface String
file_path
DynamicTooState
DT_OK -> Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> IsBootInterface
-> ModIface
-> String
-> IO ()
load_dynamic_too Logger
logger NameCache
name_cache UnitState
unit_state (DynFlags -> DynFlags
setDynamicNow DynFlags
dflags) Module
wanted_mod IsBootInterface
is_boot ModIface
iface String
file_path
load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> IsBootInterface -> ModIface -> FilePath -> IO ()
load_dynamic_too :: Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> IsBootInterface
-> ModIface
-> String
-> IO ()
load_dynamic_too Logger
logger NameCache
name_cache UnitState
unit_state DynFlags
dflags Module
wanted_mod IsBootInterface
is_boot ModIface
iface String
file_path = do
let dynFilePath :: String
dynFilePath = IsBootInterface -> String -> String
addBootSuffix_maybe IsBootInterface
is_boot
(String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
replaceExtension String
file_path (DynFlags -> String
hiSuf DynFlags
dflags)
Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> String
-> IO (MaybeErr SDoc (ModIface, String))
read_file Logger
logger NameCache
name_cache UnitState
unit_state DynFlags
dflags Module
wanted_mod String
dynFilePath IO (MaybeErr SDoc (ModIface, String))
-> (MaybeErr SDoc (ModIface, String) -> IO ()) -> IO ()
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)
-> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise ->
do Logger -> DynFlags -> SDoc -> IO ()
trace_if Logger
logger DynFlags
dflags (String -> SDoc
text String
"Dynamic hash doesn't match")
DynFlags -> IO ()
forall (m :: * -> *). MonadIO m => DynFlags -> m ()
setDynamicTooFailed DynFlags
dflags
Failed SDoc
err ->
do Logger -> DynFlags -> SDoc -> IO ()
trace_if Logger
logger DynFlags
dflags (String -> SDoc
text String
"Failed to load dynamic interface file:" SDoc -> SDoc -> SDoc
$$ SDoc
err)
DynFlags -> IO ()
forall (m :: * -> *). MonadIO m => DynFlags -> m ()
setDynamicTooFailed DynFlags
dflags
read_file :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> FilePath -> IO (MaybeErr SDoc (ModIface, FilePath))
read_file :: Logger
-> NameCache
-> UnitState
-> DynFlags
-> Module
-> String
-> IO (MaybeErr SDoc (ModIface, String))
read_file Logger
logger NameCache
name_cache UnitState
unit_state DynFlags
dflags Module
wanted_mod String
file_path = do
Logger -> DynFlags -> SDoc -> IO ()
trace_if Logger
logger DynFlags
dflags (String -> SDoc
text String
"readIFace" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
file_path)
let wanted_mod' :: Module
wanted_mod' =
case Module -> (InstalledModule, Maybe InstantiatedModule)
getModuleInstantiation Module
wanted_mod of
(InstalledModule
_, Maybe InstantiatedModule
Nothing) -> Module
wanted_mod
(InstalledModule
_, Just InstantiatedModule
indef_mod) ->
UnitState -> InstantiatedModule -> Module
instModuleToModule UnitState
unit_state
(InstantiatedModule -> InstantiatedModule
uninstantiateInstantiatedModule InstantiatedModule
indef_mod)
MaybeErr SDoc ModIface
read_result <- DynFlags
-> NameCache -> Module -> String -> IO (MaybeErr SDoc ModIface)
readIface DynFlags
dflags NameCache
name_cache Module
wanted_mod' String
file_path
case MaybeErr SDoc ModIface
read_result of
Failed SDoc
err -> MaybeErr SDoc (ModIface, String)
-> IO (MaybeErr SDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (SDoc -> MaybeErr SDoc (ModIface, String)
forall err val. err -> MaybeErr err val
Failed (String -> SDoc -> SDoc
badIfaceFile String
file_path SDoc
err))
Succeeded ModIface
iface -> MaybeErr SDoc (ModIface, String)
-> IO (MaybeErr SDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return ((ModIface, String) -> MaybeErr SDoc (ModIface, String)
forall err val. val -> MaybeErr err val
Succeeded (ModIface
iface, String
file_path))
writeIface :: Logger -> DynFlags -> FilePath -> ModIface -> IO ()
writeIface :: Logger -> DynFlags -> String -> ModIface -> IO ()
writeIface Logger
logger DynFlags
dflags 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 -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags Int
3)
profile :: Profile
profile = DynFlags -> Profile
targetProfile DynFlags
dflags
Profile -> TraceBinIFace -> String -> ModIface -> IO ()
writeBinIface Profile
profile TraceBinIFace
printer String
hi_file_path ModIface
new_iface
readIface
:: DynFlags
-> NameCache
-> Module
-> FilePath
-> IO (MaybeErr SDoc ModIface)
readIface :: DynFlags
-> NameCache -> Module -> String -> IO (MaybeErr SDoc ModIface)
readIface DynFlags
dflags NameCache
name_cache Module
wanted_mod String
file_path = do
let profile :: Profile
profile = DynFlags -> Profile
targetProfile DynFlags
dflags
Either SomeException ModIface
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 Either SomeException ModIface
res of
Right ModIface
iface
| Module
wanted_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
actual_mod
-> MaybeErr SDoc ModIface -> IO (MaybeErr SDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModIface -> MaybeErr SDoc ModIface
forall err val. val -> MaybeErr err val
Succeeded ModIface
iface)
| Bool
otherwise -> MaybeErr SDoc ModIface -> IO (MaybeErr SDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (SDoc -> MaybeErr SDoc ModIface
forall err val. err -> MaybeErr err val
Failed SDoc
err)
where
actual_mod :: Module
actual_mod = ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface
err :: SDoc
err = Module -> Module -> SDoc
hiModuleNameMismatchWarn Module
wanted_mod Module
actual_mod
Left SomeException
exn -> MaybeErr SDoc ModIface -> IO (MaybeErr SDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (SDoc -> MaybeErr SDoc ModIface
forall err val. err -> MaybeErr err val
Failed (String -> SDoc
text (SomeException -> String
forall e. Exception e => e -> String
showException SomeException
exn)))
initExternalPackageState :: ExternalPackageState
initExternalPackageState :: ExternalPackageState
initExternalPackageState
= EPS :: UniqFM ModuleName ModuleNameWithIsBoot
-> PackageIfaceTable
-> InstalledModuleEnv (UniqDSet ModuleName)
-> TypeEnv
-> PackageInstEnv
-> PackageFamInstEnv
-> PackageRuleBase
-> PackageAnnEnv
-> [CompleteMatch]
-> ModuleEnv PackageFamInstEnv
-> EpsStats
-> ExternalPackageState
EPS {
eps_is_boot :: UniqFM ModuleName ModuleNameWithIsBoot
eps_is_boot = UniqFM ModuleName ModuleNameWithIsBoot
forall key elt. UniqFM key elt
emptyUFM,
eps_PIT :: PackageIfaceTable
eps_PIT = PackageIfaceTable
emptyPackageIfaceTable,
eps_free_holes :: InstalledModuleEnv (UniqDSet ModuleName)
eps_free_holes = InstalledModuleEnv (UniqDSet ModuleName)
forall a. InstalledModuleEnv a
emptyInstalledModuleEnv,
eps_PTE :: TypeEnv
eps_PTE = TypeEnv
emptyTypeEnv,
eps_inst_env :: PackageInstEnv
eps_inst_env = PackageInstEnv
emptyInstEnv,
eps_fam_inst_env :: PackageFamInstEnv
eps_fam_inst_env = PackageFamInstEnv
emptyFamInstEnv,
eps_rule_base :: PackageRuleBase
eps_rule_base = [CoreRule] -> PackageRuleBase
mkRuleBase [CoreRule]
builtinRules,
eps_mod_fam_inst_env :: ModuleEnv PackageFamInstEnv
eps_mod_fam_inst_env = ModuleEnv PackageFamInstEnv
forall a. ModuleEnv a
emptyModuleEnv,
eps_complete_matches :: [CompleteMatch]
eps_complete_matches = [],
eps_ann_env :: PackageAnnEnv
eps_ann_env = PackageAnnEnv
emptyAnnEnv,
eps_stats :: EpsStats
eps_stats = EpsStats :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> EpsStats
EpsStats { n_ifaces_in :: Int
n_ifaces_in = Int
0, n_decls_in :: Int
n_decls_in = Int
0, n_decls_out :: Int
n_decls_out = Int
0
, n_insts_in :: Int
n_insts_in = Int
0, n_insts_out :: Int
n_insts_out = Int
0
, n_rules_in :: Int
n_rules_in = [CoreRule] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CoreRule]
builtinRules, n_rules_out :: Int
n_rules_out = Int
0 }
}
ghcPrimIface :: ModIface
ghcPrimIface :: ModIface
ghcPrimIface
= ModIface
empty_iface {
mi_exports :: [IfaceExport]
mi_exports = [IfaceExport]
ghcPrimExports,
mi_decls :: [IfaceDeclExts 'ModIfaceFinal]
mi_decls = [],
mi_fixities :: [(OccName, Fixity)]
mi_fixities = [(OccName, Fixity)]
fixities,
mi_final_exts :: IfaceBackendExts 'ModIfaceFinal
mi_final_exts = (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
empty_iface){ mi_fix_fn :: OccName -> Maybe Fixity
mi_fix_fn = [(OccName, Fixity)] -> OccName -> Maybe Fixity
mkIfaceFixCache [(OccName, Fixity)]
fixities },
mi_decl_docs :: DeclDocMap
mi_decl_docs = DeclDocMap
ghcPrimDeclDocs
}
where
empty_iface :: ModIface
empty_iface = Module -> ModIface
emptyFullModIface Module
gHC_PRIM
fixities :: [(OccName, Fixity)]
fixities = (Id -> OccName
forall a. NamedThing a => a -> OccName
getOccName Id
seqId, SourceText -> Int -> FixityDirection -> Fixity
Fixity SourceText
NoSourceText Int
0 FixityDirection
InfixR)
(OccName, Fixity) -> [(OccName, Fixity)] -> [(OccName, Fixity)]
forall a. a -> [a] -> [a]
: (PrimOp -> Maybe (OccName, Fixity))
-> [PrimOp] -> [(OccName, Fixity)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe PrimOp -> Maybe (OccName, Fixity)
mkFixity [PrimOp]
allThePrimOps
mkFixity :: PrimOp -> Maybe (OccName, Fixity)
mkFixity PrimOp
op = (,) (PrimOp -> OccName
primOpOcc PrimOp
op) (Fixity -> (OccName, Fixity))
-> Maybe Fixity -> Maybe (OccName, Fixity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimOp -> Maybe Fixity
primOpFixity PrimOp
op
ifaceStats :: ExternalPackageState -> SDoc
ifaceStats :: ExternalPackageState -> SDoc
ifaceStats ExternalPackageState
eps
= [SDoc] -> SDoc
hcat [String -> SDoc
text String
"Renamer stats: ", SDoc
msg]
where
stats :: EpsStats
stats = ExternalPackageState -> EpsStats
eps_stats ExternalPackageState
eps
msg :: SDoc
msg = [SDoc] -> SDoc
vcat
[Int -> SDoc
int (EpsStats -> Int
n_ifaces_in EpsStats
stats) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"interfaces read",
[SDoc] -> SDoc
hsep [ Int -> SDoc
int (EpsStats -> Int
n_decls_out EpsStats
stats), String -> SDoc
text String
"type/class/variable imported, out of",
Int -> SDoc
int (EpsStats -> Int
n_decls_in EpsStats
stats), String -> SDoc
text String
"read"],
[SDoc] -> SDoc
hsep [ Int -> SDoc
int (EpsStats -> Int
n_insts_out EpsStats
stats), String -> SDoc
text String
"instance decls imported, out of",
Int -> SDoc
int (EpsStats -> Int
n_insts_in EpsStats
stats), String -> SDoc
text String
"read"],
[SDoc] -> SDoc
hsep [ Int -> SDoc
int (EpsStats -> Int
n_rules_out EpsStats
stats), String -> SDoc
text String
"rule decls imported, out of",
Int -> SDoc
int (EpsStats -> Int
n_rules_in EpsStats
stats), String -> SDoc
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 -> LogAction
putLogMsg Logger
logger DynFlags
dflags 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
ModIface
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 -> OccName -> QualifyName
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
print_unqual :: PrintUnqualified
print_unqual = (Module -> OccName -> QualifyName)
-> (Module -> Bool) -> QueryQualifyPackage -> PrintUnqualified
QueryQualify Module -> OccName -> QualifyName
qualifyImportedNames
Module -> Bool
neverQualifyModules
QueryQualifyPackage
neverQualifyPackages
Logger -> LogAction
putLogMsg Logger
logger DynFlags
dflags MessageClass
MCDump SrcSpan
noSrcSpan
(SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ PprStyle -> SDoc -> SDoc
withPprStyle (PrintUnqualified -> PprStyle
mkDumpStyle PrintUnqualified
print_unqual)
(SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ UnitState -> ModIface -> SDoc
pprModIface UnitState
unit_state ModIface
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
$$ UnitState -> Dependencies -> SDoc
pprDeps UnitState
unit_state (ModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps ModIface
iface)
SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
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 iface :: ModIface
iface@ModIface{ mi_final_exts :: forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts = IfaceBackendExts 'ModIfaceFinal
exts }
= [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"interface"
SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface) SDoc -> SDoc -> SDoc
<+> HscSource -> SDoc
pp_hsc_src (ModIface -> HscSource
forall (phase :: ModIfacePhase). ModIface_ phase -> HscSource
mi_hsc_src ModIface
iface)
SDoc -> SDoc -> SDoc
<+> (if ModIfaceBackend -> Bool
mi_orphan IfaceBackendExts 'ModIfaceFinal
ModIfaceBackend
exts then String -> SDoc
text String
"[orphan module]" else SDoc
Outputable.empty)
SDoc -> SDoc -> SDoc
<+> (if ModIfaceBackend -> Bool
mi_finsts IfaceBackendExts 'ModIfaceFinal
ModIfaceBackend
exts then String -> SDoc
text String
"[family instance module]" else SDoc
Outputable.empty)
SDoc -> SDoc -> SDoc
<+> (if ModIface -> Bool
forall (phase :: ModIfacePhase). ModIface_ phase -> Bool
mi_hpc ModIface
iface then String -> SDoc
text String
"[hpc]" else SDoc
Outputable.empty)
SDoc -> SDoc -> SDoc
<+> Integer -> SDoc
integer Integer
hiVersion
, Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"interface hash:" SDoc -> SDoc -> SDoc
<+> 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
text String
"ABI hash:" SDoc -> SDoc -> SDoc
<+> 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
text String
"export-list hash:" SDoc -> SDoc -> SDoc
<+> 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
text String
"orphan hash:" SDoc -> SDoc -> SDoc
<+> 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
text String
"flag hash:" SDoc -> SDoc -> SDoc
<+> 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
text String
"opt_hash:" SDoc -> SDoc -> SDoc
<+> 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
text String
"hpc_hash:" SDoc -> SDoc -> SDoc
<+> 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
text String
"plugin_hash:" SDoc -> SDoc -> SDoc
<+> 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
text String
"sig of:" SDoc -> SDoc -> SDoc
<+> 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
text String
"used TH splices:" SDoc -> SDoc -> SDoc
<+> 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
text String
"where")
, String -> SDoc
text String
"exports:"
, Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
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)))
, UnitState -> Dependencies -> SDoc
pprDeps UnitState
unit_state (ModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps ModIface
iface)
, [SDoc] -> SDoc
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
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
vcat [Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fingerprint
ver SDoc -> SDoc -> SDoc
$$ 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]
, [SDoc] -> SDoc
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
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
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))
, Warnings -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> Warnings
forall (phase :: ModIfacePhase). ModIface_ phase -> Warnings
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
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
text String
"module header:" SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (Maybe HsDocString -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> Maybe HsDocString
forall (phase :: ModIfacePhase).
ModIface_ phase -> Maybe HsDocString
mi_doc_hdr ModIface
iface))
, String -> SDoc
text String
"declaration docs:" SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (DeclDocMap -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> DeclDocMap
forall (phase :: ModIfacePhase). ModIface_ phase -> DeclDocMap
mi_decl_docs ModIface
iface))
, String -> SDoc
text String
"arg docs:" SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (ArgDocMap -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> ArgDocMap
forall (phase :: ModIfacePhase). ModIface_ phase -> ArgDocMap
mi_arg_docs ModIface
iface))
, String -> SDoc
text String
"extensible fields:" SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (ExtensibleFields -> SDoc
pprExtensibleFields (ModIface -> ExtensibleFields
forall (phase :: ModIfacePhase).
ModIface_ phase -> ExtensibleFields
mi_ext_fields ModIface
iface))
]
where
pp_hsc_src :: HscSource -> SDoc
pp_hsc_src HscSource
HsBootFile = String -> SDoc
text String
"[boot]"
pp_hsc_src HscSource
HsigFile = String -> SDoc
text String
"[hsig]"
pp_hsc_src HscSource
HsSrcFile = SDoc
Outputable.empty
pprExport :: IfaceExport -> SDoc
pprExport :: IfaceExport -> SDoc
pprExport (Avail GreName
n) = GreName -> SDoc
forall a. Outputable a => a -> SDoc
ppr GreName
n
pprExport (AvailTC Name
_ []) = SDoc
Outputable.empty
pprExport avail :: IfaceExport
avail@(AvailTC Name
n [GreName]
_) =
Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n SDoc -> SDoc -> SDoc
<> SDoc
mark SDoc -> SDoc -> SDoc
<> [GreName] -> SDoc
forall a. Outputable a => [a] -> SDoc
pp_export (IfaceExport -> [GreName]
availSubordinateGreNames IfaceExport
avail)
where
mark :: SDoc
mark | IfaceExport -> Bool
availExportsDecl IfaceExport
avail = SDoc
Outputable.empty
| Bool
otherwise = SDoc
vbar
pp_export :: [a] -> SDoc
pp_export [] = SDoc
Outputable.empty
pp_export [a]
names = SDoc -> SDoc
braces ([SDoc] -> SDoc
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 usage :: Usage
usage@UsagePackageModule{}
= Usage -> (Usage -> Module) -> SDoc
forall a. Outputable a => Usage -> (Usage -> a) -> SDoc
pprUsageImport Usage
usage Usage -> Module
usg_mod
pprUsage usage :: Usage
usage@UsageHomeModule{}
= Usage -> (Usage -> ModuleName) -> SDoc
forall a. Outputable a => Usage -> (Usage -> a) -> SDoc
pprUsageImport Usage
usage Usage -> ModuleName
usg_mod_name SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest Int
2 (
SDoc -> (Fingerprint -> SDoc) -> Maybe Fingerprint -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
Outputable.empty (\Fingerprint
v -> String -> SDoc
text String
"exports: " SDoc -> SDoc -> SDoc
<> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fingerprint
v) (Usage -> Maybe Fingerprint
usg_exports Usage
usage) SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
vcat [ OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
n SDoc -> SDoc -> SDoc
<+> Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fingerprint
v | (OccName
n,Fingerprint
v) <- Usage -> [(OccName, Fingerprint)]
usg_entities Usage
usage ]
)
pprUsage usage :: Usage
usage@UsageFile{}
= [SDoc] -> SDoc
hsep [String -> SDoc
text String
"addDependentFile",
SDoc -> SDoc
doubleQuotes (String -> SDoc
text (Usage -> String
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
hsep [String -> SDoc
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)]
pprUsageImport :: Outputable a => Usage -> (Usage -> a) -> SDoc
pprUsageImport :: Usage -> (Usage -> a) -> SDoc
pprUsageImport Usage
usage Usage -> a
usg_mod'
= [SDoc] -> SDoc
hsep [String -> SDoc
text String
"import", SDoc
safe, a -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Usage -> a
usg_mod' Usage
usage),
Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Usage -> Fingerprint
usg_mod_hash Usage
usage)]
where
safe :: SDoc
safe | Usage -> Bool
usg_safe Usage
usage = String -> SDoc
text String
"safe"
| Bool
otherwise = String -> SDoc
text String
" -/ "
pprDeps :: UnitState -> Dependencies -> SDoc
pprDeps :: UnitState -> Dependencies -> SDoc
pprDeps UnitState
unit_state (Deps { dep_mods :: Dependencies -> [ModuleNameWithIsBoot]
dep_mods = [ModuleNameWithIsBoot]
mods, dep_pkgs :: Dependencies -> [(UnitId, Bool)]
dep_pkgs = [(UnitId, Bool)]
pkgs, dep_orphs :: Dependencies -> [Module]
dep_orphs = [Module]
orphs,
dep_finsts :: Dependencies -> [Module]
dep_finsts = [Module]
finsts })
= UnitState -> SDoc -> SDoc
pprWithUnitState UnitState
unit_state (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
vcat [String -> SDoc
text String
"module dependencies:" SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
fsep ((ModuleNameWithIsBoot -> SDoc) -> [ModuleNameWithIsBoot] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ModuleNameWithIsBoot -> SDoc
forall a. Outputable a => GenWithIsBoot a -> SDoc
ppr_mod [ModuleNameWithIsBoot]
mods),
String -> SDoc
text String
"package dependencies:" SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
fsep (((UnitId, Bool) -> SDoc) -> [(UnitId, Bool)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (UnitId, Bool) -> SDoc
forall a. Outputable a => (a, Bool) -> SDoc
ppr_pkg [(UnitId, Bool)]
pkgs),
String -> SDoc
text String
"orphans:" SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
fsep ((Module -> SDoc) -> [Module] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Module]
orphs),
String -> SDoc
text String
"family instance modules:" SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
fsep ((Module -> SDoc) -> [Module] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Module]
finsts)
]
where
ppr_mod :: GenWithIsBoot a -> SDoc
ppr_mod (GWIB { gwib_mod :: forall mod. GenWithIsBoot mod -> mod
gwib_mod = a
mod_name, gwib_isBoot :: forall mod. GenWithIsBoot mod -> IsBootInterface
gwib_isBoot = IsBootInterface
boot }) = a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
mod_name SDoc -> SDoc -> SDoc
<+> IsBootInterface -> SDoc
ppr_boot IsBootInterface
boot
ppr_pkg :: (a, Bool) -> SDoc
ppr_pkg (a
pkg,Bool
trust_req) = a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
pkg SDoc -> SDoc -> SDoc
<>
(if Bool
trust_req then String -> SDoc
text String
"*" else SDoc
Outputable.empty)
ppr_boot :: IsBootInterface -> SDoc
ppr_boot IsBootInterface
IsBoot = String -> SDoc
text String
"[boot]"
ppr_boot IsBootInterface
NotBoot = SDoc
Outputable.empty
pprFixities :: [(OccName, Fixity)] -> SDoc
pprFixities :: [(OccName, Fixity)] -> SDoc
pprFixities [] = SDoc
Outputable.empty
pprFixities [(OccName, Fixity)]
fixes = String -> SDoc
text String
"fixities" SDoc -> SDoc -> SDoc
<+> ((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
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
occ
pprTrustInfo :: IfaceTrustInfo -> SDoc
pprTrustInfo :: IfaceTrustInfo -> SDoc
pprTrustInfo IfaceTrustInfo
trust = String -> SDoc
text String
"trusted:" SDoc -> SDoc -> SDoc
<+> IfaceTrustInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTrustInfo
trust
pprTrustPkg :: Bool -> SDoc
pprTrustPkg :: Bool -> SDoc
pprTrustPkg Bool
tpkg = String -> SDoc
text String
"require own pkg trusted:" SDoc -> SDoc -> SDoc
<+> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
tpkg
instance Outputable Warnings where
ppr :: Warnings -> SDoc
ppr = Warnings -> SDoc
pprWarns
pprWarns :: Warnings -> SDoc
pprWarns :: Warnings -> SDoc
pprWarns Warnings
NoWarnings = SDoc
Outputable.empty
pprWarns (WarnAll WarningTxt
txt) = String -> SDoc
text String
"Warn all" SDoc -> SDoc -> SDoc
<+> WarningTxt -> SDoc
forall a. Outputable a => a -> SDoc
ppr WarningTxt
txt
pprWarns (WarnSome [(OccName, WarningTxt)]
prs) = String -> SDoc
text String
"Warnings"
SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
vcat (((OccName, WarningTxt) -> SDoc)
-> [(OccName, WarningTxt)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (OccName, WarningTxt) -> SDoc
forall a a. (Outputable a, Outputable a) => (a, a) -> SDoc
pprWarning [(OccName, WarningTxt)]
prs)
where pprWarning :: (a, a) -> SDoc
pprWarning (a
name, a
txt) = a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
name SDoc -> SDoc -> SDoc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
txt
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
<+> String -> SDoc
text String
"annotated by" SDoc -> SDoc -> SDoc
<+> 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
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
text String
name SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"-" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
size SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"bytes"
badIfaceFile :: String -> SDoc -> SDoc
badIfaceFile :: String -> SDoc -> SDoc
badIfaceFile String
file SDoc
err
= [SDoc] -> SDoc
vcat [String -> SDoc
text String
"Bad interface file:" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
file,
Int -> SDoc -> SDoc
nest Int
4 SDoc
err]
hiModuleNameMismatchWarn :: Module -> Module -> SDoc
hiModuleNameMismatchWarn :: Module -> Module -> SDoc
hiModuleNameMismatchWarn Module
requested_mod Module
read_mod
| Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
requested_mod Unit -> QueryQualifyPackage
forall a. Eq a => a -> a -> Bool
== Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
read_mod =
[SDoc] -> SDoc
sep [String -> SDoc
text String
"Interface file contains module" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
read_mod) SDoc -> SDoc -> SDoc
<> SDoc
comma,
String -> SDoc
text String
"but we were expecting module" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
requested_mod),
[SDoc] -> SDoc
sep [String -> SDoc
text String
"Probable cause: the source code which generated interface file",
String -> SDoc
text String
"has an incompatible module name"
]
]
| Bool
otherwise =
PprStyle -> SDoc -> SDoc
withPprStyle (PrintUnqualified -> Depth -> PprStyle
mkUserStyle PrintUnqualified
alwaysQualify Depth
AllTheWay) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
hsep [ String -> SDoc
text String
"Something is amiss; requested module "
, Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
requested_mod
, String -> SDoc
text String
"differs from name found in the interface file"
, Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
read_mod
, SDoc -> SDoc
parens (String -> SDoc
text String
"if these names look the same, try again with -dppr-debug")
]
homeModError :: InstalledModule -> ModLocation -> SDoc
homeModError :: InstalledModule -> ModLocation -> SDoc
homeModError InstalledModule
mod ModLocation
location
= String -> SDoc
text String
"attempting to use module " SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
quotes (InstalledModule -> SDoc
forall a. Outputable a => a -> SDoc
ppr InstalledModule
mod)
SDoc -> SDoc -> SDoc
<> (case ModLocation -> Maybe String
ml_hs_file ModLocation
location of
Just String
file -> SDoc
space SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
parens (String -> SDoc
text String
file)
Maybe String
Nothing -> SDoc
Outputable.empty)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"which is not loaded"
cannotFindInterface :: UnitState -> HomeUnit -> Profile -> ([FilePath] -> SDoc) -> ModuleName -> InstalledFindResult -> SDoc
cannotFindInterface :: UnitState
-> HomeUnit
-> Profile
-> ([String] -> SDoc)
-> ModuleName
-> InstalledFindResult
-> SDoc
cannotFindInterface = PtrString
-> PtrString
-> UnitState
-> HomeUnit
-> Profile
-> ([String] -> SDoc)
-> ModuleName
-> InstalledFindResult
-> SDoc
cantFindInstalledErr (String -> PtrString
sLit String
"Failed to load interface for")
(String -> PtrString
sLit String
"Ambiguous interface for")
cantFindInstalledErr
:: PtrString
-> PtrString
-> UnitState
-> HomeUnit
-> Profile
-> ([FilePath] -> SDoc)
-> ModuleName
-> InstalledFindResult
-> SDoc
cantFindInstalledErr :: PtrString
-> PtrString
-> UnitState
-> HomeUnit
-> Profile
-> ([String] -> SDoc)
-> ModuleName
-> InstalledFindResult
-> SDoc
cantFindInstalledErr PtrString
cannot_find PtrString
_ UnitState
unit_state HomeUnit
home_unit Profile
profile [String] -> SDoc
tried_these ModuleName
mod_name InstalledFindResult
find_result
= PtrString -> SDoc
ptext PtrString
cannot_find SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod_name)
SDoc -> SDoc -> SDoc
$$ SDoc
more_info
where
build_tag :: String
build_tag = Ways -> String
waysBuildTag (Profile -> Ways
profileWays Profile
profile)
more_info :: SDoc
more_info
= case InstalledFindResult
find_result of
InstalledNoPackage UnitId
pkg
-> String -> SDoc
text String
"no unit id matching" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
pkg) SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"was found" SDoc -> SDoc -> SDoc
$$ UnitId -> SDoc
looks_like_srcpkgid UnitId
pkg
InstalledNotFound [String]
files Maybe UnitId
mb_pkg
| Just UnitId
pkg <- Maybe UnitId
mb_pkg, Bool -> Bool
not (HomeUnit -> UnitId -> Bool
forall u. GenHomeUnit u -> UnitId -> Bool
isHomeUnitId HomeUnit
home_unit UnitId
pkg)
-> UnitId -> [String] -> SDoc
not_found_in_package UnitId
pkg [String]
files
| [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
files
-> String -> SDoc
text String
"It is not a module in the current program, or in any known package."
| Bool
otherwise
-> [String] -> SDoc
tried_these [String]
files
InstalledFindResult
_ -> String -> SDoc
forall a. String -> a
panic String
"cantFindInstalledErr"
looks_like_srcpkgid :: UnitId -> SDoc
looks_like_srcpkgid :: UnitId -> SDoc
looks_like_srcpkgid UnitId
pk
| (UnitInfo
pkg:[UnitInfo]
pkgs) <- UnitState -> PackageId -> [UnitInfo]
searchPackageId UnitState
unit_state (FastString -> PackageId
PackageId (UnitId -> FastString
unitIdFS UnitId
pk))
= SDoc -> SDoc
parens (String -> SDoc
text String
"This unit ID looks like the source package ID;" SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"the real unit ID is" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (FastString -> SDoc
ftext (UnitId -> FastString
unitIdFS (UnitInfo -> UnitId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId UnitInfo
pkg))) SDoc -> SDoc -> SDoc
$$
(if [UnitInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnitInfo]
pkgs then SDoc
Outputable.empty
else String -> SDoc
text String
"and" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
int ([UnitInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [UnitInfo]
pkgs) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"other candidates"))
| Bool
otherwise = SDoc
Outputable.empty
not_found_in_package :: UnitId -> [String] -> SDoc
not_found_in_package UnitId
pkg [String]
files
| String
build_tag String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
""
= let
build :: String
build = if String
build_tag String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"p" then String
"profiling"
else String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
build_tag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
in
String -> SDoc
text String
"Perhaps you haven't installed the " SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
build SDoc -> SDoc -> SDoc
<>
String -> SDoc
text String
" libraries for package " SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
quotes (UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
pkg) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'?' SDoc -> SDoc -> SDoc
$$
[String] -> SDoc
tried_these [String]
files
| Bool
otherwise
= String -> SDoc
text String
"There are files missing in the " SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
quotes (UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
pkg) SDoc -> SDoc -> SDoc
<>
String -> SDoc
text String
" package," SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"try running 'ghc-pkg check'." SDoc -> SDoc -> SDoc
$$
[String] -> SDoc
tried_these [String]
files
may_show_locations :: DynFlags -> [FilePath] -> SDoc
may_show_locations :: DynFlags -> [String] -> SDoc
may_show_locations DynFlags
dflags [String]
files
| [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
files = SDoc
Outputable.empty
| DynFlags -> Int
verbosity DynFlags
dflags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 =
String -> SDoc
text String
"Use -v (or `:set -v` in ghci) " SDoc -> SDoc -> SDoc
<>
String -> SDoc
text String
"to see a list of the files searched for."
| Bool
otherwise =
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Locations searched:") Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat ((String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
text [String]
files)
cannotFindModule :: HscEnv -> ModuleName -> FindResult -> SDoc
cannotFindModule :: HscEnv -> ModuleName -> FindResult -> SDoc
cannotFindModule HscEnv
hsc_env = DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> SDoc
cannotFindModule'
(HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)
(HscEnv -> UnitEnv
hsc_unit_env HscEnv
hsc_env)
(DynFlags -> Profile
targetProfile (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env))
cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> SDoc
cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> SDoc
cannotFindModule' DynFlags
dflags UnitEnv
unit_env Profile
profile ModuleName
mod FindResult
res = UnitState -> SDoc -> SDoc
pprWithUnitState (UnitEnv -> UnitState
ue_units UnitEnv
unit_env) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
Bool
-> PtrString
-> PtrString
-> UnitEnv
-> Profile
-> ([String] -> SDoc)
-> ModuleName
-> FindResult
-> SDoc
cantFindErr (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_BuildingCabalPackage DynFlags
dflags)
(String -> PtrString
sLit String
cannotFindMsg)
(String -> PtrString
sLit String
"Ambiguous module name")
UnitEnv
unit_env
Profile
profile
(DynFlags -> [String] -> SDoc
may_show_locations DynFlags
dflags)
ModuleName
mod
FindResult
res
where
cannotFindMsg :: String
cannotFindMsg =
case FindResult
res of
NotFound { fr_mods_hidden :: FindResult -> [Unit]
fr_mods_hidden = [Unit]
hidden_mods
, fr_pkgs_hidden :: FindResult -> [Unit]
fr_pkgs_hidden = [Unit]
hidden_pkgs
, fr_unusables :: FindResult -> [(Unit, UnusableUnitReason)]
fr_unusables = [(Unit, UnusableUnitReason)]
unusables }
| Bool -> Bool
not ([Unit] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Unit]
hidden_mods Bool -> Bool -> Bool
&& [Unit] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Unit]
hidden_pkgs Bool -> Bool -> Bool
&& [(Unit, UnusableUnitReason)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Unit, UnusableUnitReason)]
unusables)
-> String
"Could not load module"
FindResult
_ -> String
"Could not find module"
cantFindErr
:: Bool
-> PtrString
-> PtrString
-> UnitEnv
-> Profile
-> ([FilePath] -> SDoc)
-> ModuleName
-> FindResult
-> SDoc
cantFindErr :: Bool
-> PtrString
-> PtrString
-> UnitEnv
-> Profile
-> ([String] -> SDoc)
-> ModuleName
-> FindResult
-> SDoc
cantFindErr Bool
_ PtrString
_ PtrString
multiple_found UnitEnv
_ Profile
_ [String] -> SDoc
_ ModuleName
mod_name (FoundMultiple [(Module, ModuleOrigin)]
mods)
| Just [Unit]
pkgs <- Maybe [Unit]
unambiguousPackages
= SDoc -> Int -> SDoc -> SDoc
hang (PtrString -> SDoc
ptext PtrString
multiple_found SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod_name) SDoc -> SDoc -> SDoc
<> SDoc
colon) Int
2 (
[SDoc] -> SDoc
sep [String -> SDoc
text String
"it was found in multiple packages:",
[SDoc] -> SDoc
hsep ((Unit -> SDoc) -> [Unit] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Unit]
pkgs) ]
)
| Bool
otherwise
= SDoc -> Int -> SDoc -> SDoc
hang (PtrString -> SDoc
ptext PtrString
multiple_found SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod_name) SDoc -> SDoc -> SDoc
<> SDoc
colon) Int
2 (
[SDoc] -> SDoc
vcat (((Module, ModuleOrigin) -> SDoc)
-> [(Module, ModuleOrigin)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Module, ModuleOrigin) -> SDoc
forall a.
(Outputable a, Outputable (GenModule a)) =>
(GenModule a, ModuleOrigin) -> SDoc
pprMod [(Module, ModuleOrigin)]
mods)
)
where
unambiguousPackages :: Maybe [Unit]
unambiguousPackages = (Maybe [Unit] -> (Module, ModuleOrigin) -> Maybe [Unit])
-> Maybe [Unit] -> [(Module, ModuleOrigin)] -> Maybe [Unit]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Maybe [Unit] -> (Module, ModuleOrigin) -> Maybe [Unit]
forall a. Maybe [a] -> (GenModule a, ModuleOrigin) -> Maybe [a]
unambiguousPackage ([Unit] -> Maybe [Unit]
forall a. a -> Maybe a
Just []) [(Module, ModuleOrigin)]
mods
unambiguousPackage :: Maybe [a] -> (GenModule a, ModuleOrigin) -> Maybe [a]
unambiguousPackage (Just [a]
xs) (GenModule a
m, ModOrigin (Just Bool
_) [UnitInfo]
_ [UnitInfo]
_ Bool
_)
= [a] -> Maybe [a]
forall a. a -> Maybe a
Just (GenModule a -> a
forall unit. GenModule unit -> unit
moduleUnit GenModule a
m a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)
unambiguousPackage Maybe [a]
_ (GenModule a, ModuleOrigin)
_ = Maybe [a]
forall a. Maybe a
Nothing
pprMod :: (GenModule a, ModuleOrigin) -> SDoc
pprMod (GenModule a
m, ModuleOrigin
o) = String -> SDoc
text String
"it is bound as" SDoc -> SDoc -> SDoc
<+> GenModule a -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenModule a
m SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"by" SDoc -> SDoc -> SDoc
<+> GenModule a -> ModuleOrigin -> SDoc
forall a. Outputable a => GenModule a -> ModuleOrigin -> SDoc
pprOrigin GenModule a
m ModuleOrigin
o
pprOrigin :: GenModule a -> ModuleOrigin -> SDoc
pprOrigin GenModule a
_ ModuleOrigin
ModHidden = String -> SDoc
forall a. String -> a
panic String
"cantFindErr: bound by mod hidden"
pprOrigin GenModule a
_ (ModUnusable UnusableUnitReason
_) = String -> SDoc
forall a. String -> a
panic String
"cantFindErr: bound by mod unusable"
pprOrigin GenModule a
m (ModOrigin Maybe Bool
e [UnitInfo]
res [UnitInfo]
_ Bool
f) = [SDoc] -> SDoc
sep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma (
if Maybe Bool
e Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
then [String -> SDoc
text String
"package" SDoc -> SDoc -> SDoc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr (GenModule a -> a
forall unit. GenModule unit -> unit
moduleUnit GenModule a
m)]
else [] [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++
(UnitInfo -> SDoc) -> [UnitInfo] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> SDoc
text String
"a reexport in package" SDoc -> SDoc -> SDoc
<+>)
(SDoc -> SDoc) -> (UnitInfo -> SDoc) -> UnitInfo -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr(Unit -> SDoc) -> (UnitInfo -> Unit) -> UnitInfo -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.UnitInfo -> Unit
mkUnit) [UnitInfo]
res [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++
if Bool
f then [String -> SDoc
text String
"a package flag"] else []
)
cantFindErr Bool
using_cabal PtrString
cannot_find PtrString
_ UnitEnv
unit_env Profile
profile [String] -> SDoc
tried_these ModuleName
mod_name FindResult
find_result
= PtrString -> SDoc
ptext PtrString
cannot_find SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod_name)
SDoc -> SDoc -> SDoc
$$ SDoc
more_info
where
home_unit :: HomeUnit
home_unit = UnitEnv -> HomeUnit
ue_home_unit UnitEnv
unit_env
more_info :: SDoc
more_info
= case FindResult
find_result of
NoPackage Unit
pkg
-> String -> SDoc
text String
"no unit id matching" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unit
pkg) SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"was found"
NotFound { fr_paths :: FindResult -> [String]
fr_paths = [String]
files, fr_pkg :: FindResult -> Maybe Unit
fr_pkg = Maybe Unit
mb_pkg
, fr_mods_hidden :: FindResult -> [Unit]
fr_mods_hidden = [Unit]
mod_hiddens, fr_pkgs_hidden :: FindResult -> [Unit]
fr_pkgs_hidden = [Unit]
pkg_hiddens
, fr_unusables :: FindResult -> [(Unit, UnusableUnitReason)]
fr_unusables = [(Unit, UnusableUnitReason)]
unusables, fr_suggestions :: FindResult -> [ModuleSuggestion]
fr_suggestions = [ModuleSuggestion]
suggest }
| Just Unit
pkg <- Maybe Unit
mb_pkg, Bool -> Bool
not (HomeUnit -> QueryQualifyPackage
isHomeUnit HomeUnit
home_unit Unit
pkg)
-> Unit -> [String] -> SDoc
not_found_in_package Unit
pkg [String]
files
| Bool -> Bool
not ([ModuleSuggestion] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleSuggestion]
suggest)
-> [ModuleSuggestion] -> SDoc
pp_suggestions [ModuleSuggestion]
suggest SDoc -> SDoc -> SDoc
$$ [String] -> SDoc
tried_these [String]
files
| [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
files Bool -> Bool -> Bool
&& [Unit] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Unit]
mod_hiddens Bool -> Bool -> Bool
&&
[Unit] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Unit]
pkg_hiddens Bool -> Bool -> Bool
&& [(Unit, UnusableUnitReason)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Unit, UnusableUnitReason)]
unusables
-> String -> SDoc
text String
"It is not a module in the current program, or in any known package."
| Bool
otherwise
-> [SDoc] -> SDoc
vcat ((Unit -> SDoc) -> [Unit] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Unit -> SDoc
pkg_hidden [Unit]
pkg_hiddens) SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
vcat ((Unit -> SDoc) -> [Unit] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Unit -> SDoc
forall a. Outputable a => a -> SDoc
mod_hidden [Unit]
mod_hiddens) SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
vcat (((Unit, UnusableUnitReason) -> SDoc)
-> [(Unit, UnusableUnitReason)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Unit, UnusableUnitReason) -> SDoc
forall a. Outputable a => (a, UnusableUnitReason) -> SDoc
unusable [(Unit, UnusableUnitReason)]
unusables) SDoc -> SDoc -> SDoc
$$
[String] -> SDoc
tried_these [String]
files
FindResult
_ -> String -> SDoc
forall a. String -> a
panic String
"cantFindErr"
build_tag :: String
build_tag = Ways -> String
waysBuildTag (Profile -> Ways
profileWays Profile
profile)
not_found_in_package :: Unit -> [String] -> SDoc
not_found_in_package Unit
pkg [String]
files
| String
build_tag String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
""
= let
build :: String
build = if String
build_tag String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"p" then String
"profiling"
else String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
build_tag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
in
String -> SDoc
text String
"Perhaps you haven't installed the " SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
build SDoc -> SDoc -> SDoc
<>
String -> SDoc
text String
" libraries for package " SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
quotes (Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unit
pkg) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'?' SDoc -> SDoc -> SDoc
$$
[String] -> SDoc
tried_these [String]
files
| Bool
otherwise
= String -> SDoc
text String
"There are files missing in the " SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
quotes (Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unit
pkg) SDoc -> SDoc -> SDoc
<>
String -> SDoc
text String
" package," SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"try running 'ghc-pkg check'." SDoc -> SDoc -> SDoc
$$
[String] -> SDoc
tried_these [String]
files
pkg_hidden :: Unit -> SDoc
pkg_hidden :: Unit -> SDoc
pkg_hidden Unit
uid =
String -> SDoc
text String
"It is a member of the hidden package"
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unit
uid)
SDoc -> SDoc -> SDoc
<> SDoc
dot SDoc -> SDoc -> SDoc
$$ Unit -> SDoc
pkg_hidden_hint Unit
uid
pkg_hidden_hint :: Unit -> SDoc
pkg_hidden_hint Unit
uid
| Bool
using_cabal
= let pkg :: UnitInfo
pkg = String -> Maybe UnitInfo -> UnitInfo
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"pkg_hidden" (UnitState -> Unit -> Maybe UnitInfo
lookupUnit (UnitEnv -> UnitState
ue_units UnitEnv
unit_env) Unit
uid)
in String -> SDoc
text String
"Perhaps you need to add" SDoc -> SDoc -> SDoc
<+>
SDoc -> SDoc
quotes (PackageName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnitInfo -> PackageName
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> srcpkgname
unitPackageName UnitInfo
pkg)) SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"to the build-depends in your .cabal file."
| Just UnitInfo
pkg <- UnitState -> Unit -> Maybe UnitInfo
lookupUnit (UnitEnv -> UnitState
ue_units UnitEnv
unit_env) Unit
uid
= String -> SDoc
text String
"You can run" SDoc -> SDoc -> SDoc
<+>
SDoc -> SDoc
quotes (String -> SDoc
text String
":set -package " SDoc -> SDoc -> SDoc
<> PackageName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnitInfo -> PackageName
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> srcpkgname
unitPackageName UnitInfo
pkg)) SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"to expose it." SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"(Note: this unloads all the modules in the current scope.)"
| Bool
otherwise = SDoc
Outputable.empty
mod_hidden :: a -> SDoc
mod_hidden a
pkg =
String -> SDoc
text String
"it is a hidden module in the package" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
pkg)
unusable :: (a, UnusableUnitReason) -> SDoc
unusable (a
pkg, UnusableUnitReason
reason)
= String -> SDoc
text String
"It is a member of the package"
SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
pkg)
SDoc -> SDoc -> SDoc
$$ SDoc -> UnusableUnitReason -> SDoc
pprReason (String -> SDoc
text String
"which is") UnusableUnitReason
reason
pp_suggestions :: [ModuleSuggestion] -> SDoc
pp_suggestions :: [ModuleSuggestion] -> SDoc
pp_suggestions [ModuleSuggestion]
sugs
| [ModuleSuggestion] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleSuggestion]
sugs = SDoc
Outputable.empty
| Bool
otherwise = SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Perhaps you meant")
Int
2 ([SDoc] -> SDoc
vcat ((ModuleSuggestion -> SDoc) -> [ModuleSuggestion] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ModuleSuggestion -> SDoc
pp_sugg [ModuleSuggestion]
sugs))
pp_sugg :: ModuleSuggestion -> SDoc
pp_sugg (SuggestVisible ModuleName
m Module
mod ModuleOrigin
o) = ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
m SDoc -> SDoc -> SDoc
<+> ModuleOrigin -> SDoc
provenance ModuleOrigin
o
where provenance :: ModuleOrigin -> SDoc
provenance ModuleOrigin
ModHidden = SDoc
Outputable.empty
provenance (ModUnusable UnusableUnitReason
_) = SDoc
Outputable.empty
provenance (ModOrigin{ fromOrigUnit :: ModuleOrigin -> Maybe Bool
fromOrigUnit = Maybe Bool
e,
fromExposedReexport :: ModuleOrigin -> [UnitInfo]
fromExposedReexport = [UnitInfo]
res,
fromPackageFlag :: ModuleOrigin -> Bool
fromPackageFlag = Bool
f })
| Just Bool
True <- Maybe Bool
e
= SDoc -> SDoc
parens (String -> SDoc
text String
"from" SDoc -> SDoc -> SDoc
<+> Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod))
| Bool
f Bool -> Bool -> Bool
&& Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
m
= SDoc -> SDoc
parens (String -> SDoc
text String
"from" SDoc -> SDoc -> SDoc
<+> Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod))
| (UnitInfo
pkg:[UnitInfo]
_) <- [UnitInfo]
res
= SDoc -> SDoc
parens (String -> SDoc
text String
"from" SDoc -> SDoc -> SDoc
<+> Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnitInfo -> Unit
mkUnit UnitInfo
pkg)
SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"reexporting" SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod)
| Bool
f
= SDoc -> SDoc
parens (String -> SDoc
text String
"defined via package flags to be"
SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod)
| Bool
otherwise = SDoc
Outputable.empty
pp_sugg (SuggestHidden ModuleName
m Module
mod ModuleOrigin
o) = ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
m SDoc -> SDoc -> SDoc
<+> ModuleOrigin -> SDoc
provenance ModuleOrigin
o
where provenance :: ModuleOrigin -> SDoc
provenance ModuleOrigin
ModHidden = SDoc
Outputable.empty
provenance (ModUnusable UnusableUnitReason
_) = SDoc
Outputable.empty
provenance (ModOrigin{ fromOrigUnit :: ModuleOrigin -> Maybe Bool
fromOrigUnit = Maybe Bool
e,
fromHiddenReexport :: ModuleOrigin -> [UnitInfo]
fromHiddenReexport = [UnitInfo]
rhs })
| Just Bool
False <- Maybe Bool
e
= SDoc -> SDoc
parens (String -> SDoc
text String
"needs flag -package-id"
SDoc -> SDoc -> SDoc
<+> Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod))
| (UnitInfo
pkg:[UnitInfo]
_) <- [UnitInfo]
rhs
= SDoc -> SDoc
parens (String -> SDoc
text String
"needs flag -package-id"
SDoc -> SDoc -> SDoc
<+> Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnitInfo -> Unit
mkUnit UnitInfo
pkg))
| Bool
otherwise = SDoc
Outputable.empty