{-# LANGUAGE CPP, BangPatterns, RecordWildCards, NondecreasingIndentation #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module LoadIface (
tcLookupImported_maybe, importDecl,
checkWiredInTyCon, ifCheckWiredInThing,
loadModuleInterface, loadModuleInterfaces,
loadSrcInterface, loadSrcInterface_maybe,
loadInterfaceForName, loadInterfaceForNameMaybe, loadInterfaceForModule,
loadInterface,
loadSysInterface, loadUserInterface, loadPluginInterface,
findAndReadIface, readIface,
loadDecls,
initExternalPackageState,
moduleFreeHolesPrecise,
needWiredInHomeIface, loadWiredInHomeIface,
pprModIfaceSimple,
ifaceStats, pprModIface, showIface
) where
#include "HsVersions.h"
import GhcPrelude
import {-# SOURCE #-} TcIface( tcIfaceDecl, tcIfaceRules, tcIfaceInst,
tcIfaceFamInst,
tcIfaceAnnotations, tcIfaceCompleteSigs )
import DynFlags
import IfaceSyn
import IfaceEnv
import HscTypes
import BasicTypes hiding (SuccessFlag(..))
import TcRnMonad
import Constants
import PrelNames
import PrelInfo
import PrimOp ( allThePrimOps, primOpFixity, primOpOcc )
import MkId ( seqId )
import TysPrim ( funTyConName )
import Rules
import TyCon
import Annotations
import InstEnv
import FamInstEnv
import Name
import NameEnv
import Avail
import Module
import Maybes
import ErrUtils
import Finder
import UniqFM
import SrcLoc
import Outputable
import BinIface
import Panic
import Util
import FastString
import Fingerprint
import Hooks
import FieldLabel
import RnModIface
import UniqDSet
import Plugins
import Control.Monad
import Control.Exception
import Data.IORef
import System.FilePath
tcLookupImported_maybe :: Name -> TcM (MaybeErr MsgDoc TyThing)
tcLookupImported_maybe :: Name -> TcM (MaybeErr MsgDoc TyThing)
tcLookupImported_maybe name :: 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)
lookupTypeHscEnv HscEnv
hsc_env Name
name)
; case Maybe TyThing
mb_thing of
Just thing :: TyThing
thing -> MaybeErr MsgDoc TyThing -> TcM (MaybeErr MsgDoc TyThing)
forall (m :: * -> *) a. Monad m => a -> m a
return (TyThing -> MaybeErr MsgDoc TyThing
forall err val. val -> MaybeErr err val
Succeeded TyThing
thing)
Nothing -> Name -> TcM (MaybeErr MsgDoc TyThing)
tcImportDecl_maybe Name
name }
tcImportDecl_maybe :: Name -> TcM (MaybeErr MsgDoc TyThing)
tcImportDecl_maybe :: Name -> TcM (MaybeErr MsgDoc TyThing)
tcImportDecl_maybe name :: Name
name
| Just thing :: 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 MsgDoc TyThing -> TcM (MaybeErr MsgDoc TyThing)
forall (m :: * -> *) a. Monad m => a -> m a
return (TyThing -> MaybeErr MsgDoc TyThing
forall err val. val -> MaybeErr err val
Succeeded TyThing
thing) }
| Bool
otherwise
= IfG (MaybeErr MsgDoc TyThing) -> TcM (MaybeErr MsgDoc TyThing)
forall a. IfG a -> TcRn a
initIfaceTcRn (Name -> IfG (MaybeErr MsgDoc TyThing)
forall lcl. Name -> IfM lcl (MaybeErr MsgDoc TyThing)
importDecl Name
name)
importDecl :: Name -> IfM lcl (MaybeErr MsgDoc TyThing)
importDecl :: Name -> IfM lcl (MaybeErr MsgDoc TyThing)
importDecl name :: Name
name
= ASSERT( not (isWiredInName name) )
do { MsgDoc -> TcRnIf IfGblEnv lcl ()
forall m n. MsgDoc -> TcRnIf m n ()
traceIf MsgDoc
nd_doc
; MaybeErr MsgDoc ModIface
mb_iface <- ASSERT2( isExternalName name, ppr name )
MsgDoc
-> Module
-> WhereFrom
-> IOEnv (Env IfGblEnv lcl) (MaybeErr MsgDoc ModIface)
forall lcl.
MsgDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr MsgDoc ModIface)
loadInterface MsgDoc
nd_doc (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name) WhereFrom
ImportBySystem
; case MaybeErr MsgDoc ModIface
mb_iface of {
Failed err_msg :: MsgDoc
err_msg -> MaybeErr MsgDoc TyThing -> IfM lcl (MaybeErr MsgDoc TyThing)
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc TyThing
forall err val. err -> MaybeErr err val
Failed MsgDoc
err_msg) ;
Succeeded _ -> 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 thing :: TyThing
thing -> MaybeErr MsgDoc TyThing -> IfM lcl (MaybeErr MsgDoc TyThing)
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeErr MsgDoc TyThing -> IfM lcl (MaybeErr MsgDoc TyThing))
-> MaybeErr MsgDoc TyThing -> IfM lcl (MaybeErr MsgDoc TyThing)
forall a b. (a -> b) -> a -> b
$ TyThing -> MaybeErr MsgDoc TyThing
forall err val. val -> MaybeErr err val
Succeeded TyThing
thing
Nothing -> let doc :: MsgDoc
doc = MsgDoc -> MsgDoc
whenPprDebug (ExternalPackageState -> MsgDoc
found_things_msg ExternalPackageState
eps MsgDoc -> MsgDoc -> MsgDoc
$$ MsgDoc
empty)
MsgDoc -> MsgDoc -> MsgDoc
$$ MsgDoc
not_found_msg
in MaybeErr MsgDoc TyThing -> IfM lcl (MaybeErr MsgDoc TyThing)
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeErr MsgDoc TyThing -> IfM lcl (MaybeErr MsgDoc TyThing))
-> MaybeErr MsgDoc TyThing -> IfM lcl (MaybeErr MsgDoc TyThing)
forall a b. (a -> b) -> a -> b
$ MsgDoc -> MaybeErr MsgDoc TyThing
forall err val. err -> MaybeErr err val
Failed MsgDoc
doc
}}}
where
nd_doc :: MsgDoc
nd_doc = String -> MsgDoc
text "Need decl for" MsgDoc -> MsgDoc -> MsgDoc
<+> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
name
not_found_msg :: MsgDoc
not_found_msg = MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text "Can't find interface-file declaration for" MsgDoc -> MsgDoc -> MsgDoc
<+>
NameSpace -> MsgDoc
pprNameSpace (OccName -> NameSpace
occNameSpace (Name -> OccName
nameOccName Name
name)) MsgDoc -> MsgDoc -> MsgDoc
<+> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
name)
2 ([MsgDoc] -> MsgDoc
vcat [String -> MsgDoc
text "Probable cause: bug in .hi-boot file, or inconsistent .hi file",
String -> MsgDoc
text "Use -ddump-if-trace to get an idea of which file caused the error"])
found_things_msg :: ExternalPackageState -> MsgDoc
found_things_msg eps :: ExternalPackageState
eps =
MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text "Found the following declarations in" MsgDoc -> MsgDoc -> MsgDoc
<+> Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name) MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
colon)
2 ([MsgDoc] -> MsgDoc
vcat ((TyThing -> MsgDoc) -> [TyThing] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map TyThing -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ([TyThing] -> [MsgDoc]) -> [TyThing] -> [MsgDoc]
forall a b. (a -> b) -> a -> b
$ (TyThing -> Bool) -> [TyThing] -> [TyThing]
forall a. (a -> Bool) -> [a] -> [a]
filter TyThing -> Bool
forall a. NamedThing a => a -> 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 :: a -> Bool
is_interesting thing :: a
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 (a -> Name
forall a. NamedThing a => a -> Name
getName a
thing)
checkWiredInTyCon :: TyCon -> TcM ()
checkWiredInTyCon :: TyCon -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkWiredInTyCon tc :: 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
; MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall m n. MsgDoc -> TcRnIf m n ()
traceIf (String -> MsgDoc
text "checkWiredInTyCon" MsgDoc -> MsgDoc -> MsgDoc
<+> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
tc_name MsgDoc -> MsgDoc -> MsgDoc
$$ Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
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 thing :: 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 _ = Bool
False
loadSrcInterface :: SDoc
-> ModuleName
-> IsBootInterface
-> Maybe FastString
-> RnM ModIface
loadSrcInterface :: MsgDoc -> ModuleName -> Bool -> Maybe FastString -> RnM ModIface
loadSrcInterface doc :: MsgDoc
doc mod :: ModuleName
mod want_boot :: Bool
want_boot maybe_pkg :: Maybe FastString
maybe_pkg
= do { MaybeErr MsgDoc ModIface
res <- MsgDoc
-> ModuleName
-> Bool
-> Maybe FastString
-> RnM (MaybeErr MsgDoc ModIface)
loadSrcInterface_maybe MsgDoc
doc ModuleName
mod Bool
want_boot Maybe FastString
maybe_pkg
; case MaybeErr MsgDoc ModIface
res of
Failed err :: MsgDoc
err -> MsgDoc -> RnM ModIface
forall a. MsgDoc -> TcM a
failWithTc MsgDoc
err
Succeeded iface :: 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 MsgDoc ModIface)
loadSrcInterface_maybe :: MsgDoc
-> ModuleName
-> Bool
-> Maybe FastString
-> RnM (MaybeErr MsgDoc ModIface)
loadSrcInterface_maybe doc :: MsgDoc
doc mod :: ModuleName
mod want_boot :: Bool
want_boot maybe_pkg :: Maybe FastString
maybe_pkg
= do { HscEnv
hsc_env <- TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
; 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
$ HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
findImportedModule HscEnv
hsc_env ModuleName
mod Maybe FastString
maybe_pkg
; case FindResult
res of
Found _ mod :: Module
mod -> IfG (MaybeErr MsgDoc ModIface) -> RnM (MaybeErr MsgDoc ModIface)
forall a. IfG a -> TcRn a
initIfaceTcRn (IfG (MaybeErr MsgDoc ModIface) -> RnM (MaybeErr MsgDoc ModIface))
-> IfG (MaybeErr MsgDoc ModIface) -> RnM (MaybeErr MsgDoc ModIface)
forall a b. (a -> b) -> a -> b
$ MsgDoc -> Module -> WhereFrom -> IfG (MaybeErr MsgDoc ModIface)
forall lcl.
MsgDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr MsgDoc ModIface)
loadInterface MsgDoc
doc Module
mod (Bool -> WhereFrom
ImportByUser Bool
want_boot)
err :: FindResult
err -> MaybeErr MsgDoc ModIface -> RnM (MaybeErr MsgDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc ModIface
forall err val. err -> MaybeErr err val
Failed (DynFlags -> ModuleName -> FindResult -> MsgDoc
cannotFindModule (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env) ModuleName
mod FindResult
err)) }
loadModuleInterface :: SDoc -> Module -> TcM ModIface
loadModuleInterface :: MsgDoc -> Module -> RnM ModIface
loadModuleInterface doc :: MsgDoc
doc mod :: Module
mod = IfG ModIface -> RnM ModIface
forall a. IfG a -> TcRn a
initIfaceTcRn (MsgDoc -> Module -> IfG ModIface
forall lcl. MsgDoc -> Module -> IfM lcl ModIface
loadSysInterface MsgDoc
doc Module
mod)
loadModuleInterfaces :: SDoc -> [Module] -> TcM ()
loadModuleInterfaces :: MsgDoc -> [Module] -> IOEnv (Env TcGblEnv TcLclEnv) ()
loadModuleInterfaces doc :: MsgDoc
doc mods :: [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
forall lcl. Module -> IfM lcl ModIface
load [Module]
mods)
where
load :: Module -> IfM lcl ModIface
load mod :: Module
mod = MsgDoc -> Module -> IfM lcl ModIface
forall lcl. MsgDoc -> Module -> IfM lcl ModIface
loadSysInterface (MsgDoc
doc MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
parens (Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Module
mod)) Module
mod
loadInterfaceForName :: SDoc -> Name -> TcRn ModIface
loadInterfaceForName :: MsgDoc -> Name -> RnM ModIface
loadInterfaceForName doc :: MsgDoc
doc name :: 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
$ MsgDoc -> Module -> IfG ModIface
forall lcl. MsgDoc -> Module -> IfM lcl ModIface
loadSysInterface MsgDoc
doc (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name) }
loadInterfaceForNameMaybe :: SDoc -> Name -> TcRn (Maybe ModIface)
loadInterfaceForNameMaybe :: MsgDoc -> Name -> TcRn (Maybe ModIface)
loadInterfaceForNameMaybe doc :: MsgDoc
doc name :: 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
$ MsgDoc -> Module -> IfG ModIface
forall lcl. MsgDoc -> Module -> IfM lcl ModIface
loadSysInterface MsgDoc
doc (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name))
}
loadInterfaceForModule :: SDoc -> Module -> TcRn ModIface
loadInterfaceForModule :: MsgDoc -> Module -> RnM ModIface
loadInterfaceForModule doc :: MsgDoc
doc m :: 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
$ MsgDoc -> Module -> IfG ModIface
forall lcl. MsgDoc -> Module -> IfM lcl ModIface
loadSysInterface MsgDoc
doc Module
m
loadWiredInHomeIface :: Name -> IfM lcl ()
loadWiredInHomeIface :: Name -> IfM lcl ()
loadWiredInHomeIface name :: Name
name
= ASSERT( isWiredInName name )
do ModIface
_ <- MsgDoc -> Module -> IfM lcl ModIface
forall lcl. MsgDoc -> Module -> IfM lcl ModIface
loadSysInterface MsgDoc
doc (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name); () -> IfM lcl ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
doc :: MsgDoc
doc = String -> MsgDoc
text "Need home interface for wired-in thing" MsgDoc -> MsgDoc -> MsgDoc
<+> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
name
loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
loadSysInterface :: MsgDoc -> Module -> IfM lcl ModIface
loadSysInterface doc :: MsgDoc
doc mod_name :: Module
mod_name = MsgDoc -> Module -> WhereFrom -> IfM lcl ModIface
forall lcl. MsgDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException MsgDoc
doc Module
mod_name WhereFrom
ImportBySystem
loadUserInterface :: Bool -> SDoc -> Module -> IfM lcl ModIface
loadUserInterface :: Bool -> MsgDoc -> Module -> IfM lcl ModIface
loadUserInterface is_boot :: Bool
is_boot doc :: MsgDoc
doc mod_name :: Module
mod_name
= MsgDoc -> Module -> WhereFrom -> IfM lcl ModIface
forall lcl. MsgDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException MsgDoc
doc Module
mod_name (Bool -> WhereFrom
ImportByUser Bool
is_boot)
loadPluginInterface :: SDoc -> Module -> IfM lcl ModIface
loadPluginInterface :: MsgDoc -> Module -> IfM lcl ModIface
loadPluginInterface doc :: MsgDoc
doc mod_name :: Module
mod_name
= MsgDoc -> Module -> WhereFrom -> IfM lcl ModIface
forall lcl. MsgDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException MsgDoc
doc Module
mod_name WhereFrom
ImportByPlugin
loadInterfaceWithException :: SDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException :: MsgDoc -> Module -> WhereFrom -> IfM lcl ModIface
loadInterfaceWithException doc :: MsgDoc
doc mod_name :: Module
mod_name where_from :: WhereFrom
where_from
= TcRnIf IfGblEnv lcl (MaybeErr MsgDoc ModIface) -> IfM lcl ModIface
forall gbl lcl a.
TcRnIf gbl lcl (MaybeErr MsgDoc a) -> TcRnIf gbl lcl a
withException (MsgDoc
-> Module
-> WhereFrom
-> TcRnIf IfGblEnv lcl (MaybeErr MsgDoc ModIface)
forall lcl.
MsgDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr MsgDoc ModIface)
loadInterface MsgDoc
doc Module
mod_name WhereFrom
where_from)
loadInterface :: SDoc -> Module -> WhereFrom
-> IfM lcl (MaybeErr MsgDoc ModIface)
loadInterface :: MsgDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr MsgDoc ModIface)
loadInterface doc_str :: MsgDoc
doc_str mod :: Module
mod from :: WhereFrom
from
| Module -> Bool
isHoleModule Module
mod
= do DynFlags
dflags <- IOEnv (Env IfGblEnv lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
MsgDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr MsgDoc ModIface)
forall lcl.
MsgDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr MsgDoc ModIface)
loadInterface MsgDoc
doc_str (UnitId -> ModuleName -> Module
mkModule (DynFlags -> UnitId
thisPackage DynFlags
dflags) (Module -> ModuleName
moduleName Module
mod)) WhereFrom
from
| Bool
otherwise
= do {
(eps :: ExternalPackageState
eps,hpt :: 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
; MsgDoc -> TcRnIf IfGblEnv lcl ()
forall m n. MsgDoc -> TcRnIf m n ()
traceIf (String -> MsgDoc
text "Considering whether to load" MsgDoc -> MsgDoc -> MsgDoc
<+> Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Module
mod MsgDoc -> MsgDoc -> MsgDoc
<+> WhereFrom -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr WhereFrom
from)
; DynFlags
dflags <- IOEnv (Env IfGblEnv lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; case DynFlags
-> HomePackageTable
-> PackageIfaceTable
-> Module
-> Maybe ModIface
lookupIfaceByModule DynFlags
dflags HomePackageTable
hpt (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) Module
mod of {
Just iface :: ModIface
iface
-> MaybeErr MsgDoc ModIface -> IfM lcl (MaybeErr MsgDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModIface -> MaybeErr MsgDoc ModIface
forall err val. val -> MaybeErr err val
Succeeded ModIface
iface) ;
_ -> do {
; MaybeErr MsgDoc (ModIface, String)
read_result <- case (DynFlags
-> ExternalPackageState
-> Module
-> WhereFrom
-> MaybeErr MsgDoc Bool
wantHiBootFile DynFlags
dflags ExternalPackageState
eps Module
mod WhereFrom
from) of
Failed err :: MsgDoc
err -> MaybeErr MsgDoc (ModIface, String)
-> IOEnv (Env IfGblEnv lcl) (MaybeErr MsgDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc (ModIface, String)
forall err val. err -> MaybeErr err val
Failed MsgDoc
err)
Succeeded hi_boot_file :: Bool
hi_boot_file -> MsgDoc
-> Bool
-> Module
-> IOEnv (Env IfGblEnv lcl) (MaybeErr MsgDoc (ModIface, String))
forall gbl lcl.
MsgDoc
-> Bool
-> Module
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
computeInterface MsgDoc
doc_str Bool
hi_boot_file Module
mod
; case MaybeErr MsgDoc (ModIface, String)
read_result of {
Failed err :: MsgDoc
err -> do
{ let fake_iface :: ModIface
fake_iface = Module -> ModIface
emptyModIface Module
mod
; (ExternalPackageState -> ExternalPackageState)
-> TcRnIf IfGblEnv lcl ()
forall gbl lcl.
(ExternalPackageState -> ExternalPackageState) -> TcRnIf gbl lcl ()
updateEps_ ((ExternalPackageState -> ExternalPackageState)
-> TcRnIf IfGblEnv lcl ())
-> (ExternalPackageState -> ExternalPackageState)
-> TcRnIf IfGblEnv lcl ()
forall a b. (a -> b) -> a -> b
$ \eps :: 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
mi_module ModIface
fake_iface) ModIface
fake_iface }
; MaybeErr MsgDoc ModIface -> IfM lcl (MaybeErr MsgDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc ModIface
forall err val. err -> MaybeErr err val
Failed MsgDoc
err) } ;
Succeeded (iface :: ModIface
iface, loc :: String
loc) ->
let
loc_doc :: MsgDoc
loc_doc = String -> MsgDoc
text String
loc
in
Module
-> MsgDoc
-> Bool
-> IfL (MaybeErr MsgDoc ModIface)
-> IfM lcl (MaybeErr MsgDoc ModIface)
forall a lcl. Module -> MsgDoc -> Bool -> IfL a -> IfM lcl a
initIfaceLcl (ModIface -> Module
mi_semantic_module ModIface
iface) MsgDoc
loc_doc (ModIface -> Bool
mi_boot ModIface
iface) (IfL (MaybeErr MsgDoc ModIface)
-> IfM lcl (MaybeErr MsgDoc ModIface))
-> IfL (MaybeErr MsgDoc ModIface)
-> IfM lcl (MaybeErr MsgDoc ModIface)
forall a b. (a -> b) -> a -> b
$ do
IfL (MaybeErr MsgDoc ModIface) -> IfL (MaybeErr MsgDoc ModIface)
forall a. IfL a -> IfL a
dontLeakTheHPT (IfL (MaybeErr MsgDoc ModIface) -> IfL (MaybeErr MsgDoc ModIface))
-> IfL (MaybeErr MsgDoc ModIface) -> IfL (MaybeErr MsgDoc 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)]
loadDecls Bool
ignore_prags (ModIface -> [(Fingerprint, IfaceDecl)]
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]
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]
mi_fam_insts ModIface
iface)
; [CoreRule]
new_eps_rules <- Bool -> [IfaceRule] -> IfL [CoreRule]
tcIfaceRules Bool
ignore_prags (ModIface -> [IfaceRule]
mi_rules ModIface
iface)
; [Annotation]
new_eps_anns <- [IfaceAnnotation] -> IfL [Annotation]
tcIfaceAnnotations (ModIface -> [IfaceAnnotation]
mi_anns ModIface
iface)
; [CompleteMatch]
new_eps_complete_sigs <- [IfaceCompleteMatch] -> IfL [CompleteMatch]
tcIfaceCompleteSigs (ModIface -> [IfaceCompleteMatch]
mi_complete_sigs ModIface
iface)
; let { final_iface :: ModIface
final_iface = ModIface
iface {
mi_decls :: [(Fingerprint, IfaceDecl)]
mi_decls = String -> [(Fingerprint, IfaceDecl)]
forall a. String -> a
panic "No mi_decls in PIT",
mi_insts :: [IfaceClsInst]
mi_insts = String -> [IfaceClsInst]
forall a. String -> a
panic "No mi_insts in PIT",
mi_fam_insts :: [IfaceFamInst]
mi_fam_insts = String -> [IfaceFamInst]
forall a. String -> a
panic "No mi_fam_insts in PIT",
mi_rules :: [IfaceRule]
mi_rules = String -> [IfaceRule]
forall a. String -> a
panic "No mi_rules in PIT",
mi_anns :: [IfaceAnnotation]
mi_anns = String -> [IfaceAnnotation]
forall a. String -> a
panic "No mi_anns in PIT"
}
}
; let bad_boot :: Bool
bad_boot = ModIface -> Bool
mi_boot ModIface
iface 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
$ \ eps :: ExternalPackageState
eps ->
if Module -> PackageIfaceTable -> Bool
forall a. Module -> ModuleEnv a -> Bool
elemModuleEnv Module
mod (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) Bool -> Bool -> Bool
|| DynFlags -> ModIface -> Bool
is_external_sig DynFlags
dflags 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 :: PackageCompleteMatchMap
eps_complete_matches
= PackageCompleteMatchMap
-> [CompleteMatch] -> PackageCompleteMatchMap
extendCompleteMatchMap
(ExternalPackageState -> PackageCompleteMatchMap
eps_complete_matches ExternalPackageState
eps)
[CompleteMatch]
new_eps_complete_sigs,
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 <- DynFlags
-> PluginOperation (IOEnv (Env IfGblEnv IfLclEnv)) ModIface
-> ModIface
-> IOEnv (Env IfGblEnv IfLclEnv) ModIface
forall (m :: * -> *) a.
Monad m =>
DynFlags -> PluginOperation m a -> a -> m a
withPlugins DynFlags
dflags PluginOperation (IOEnv (Env IfGblEnv IfLclEnv)) ModIface
Plugin -> forall lcl. [String] -> ModIface -> IfM lcl ModIface
interfaceLoadAction ModIface
final_iface
; MaybeErr MsgDoc ModIface -> IfL (MaybeErr MsgDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModIface -> MaybeErr MsgDoc ModIface
forall err val. val -> MaybeErr err val
Succeeded ModIface
res)
}}}}
dontLeakTheHPT :: IfL a -> IfL a
dontLeakTheHPT :: IfL a -> IfL a
dontLeakTheHPT thing_inside :: IfL a
thing_inside = do
let
cleanTopEnv :: HscEnv -> HscEnv
cleanTopEnv HscEnv{..} =
let
!hpt :: HomePackageTable
hpt | DynFlags -> HscTarget
hscTarget DynFlags
hsc_dflags HscTarget -> HscTarget -> Bool
forall a. Eq a => a -> a -> Bool
== HscTarget
HscNothing = HomePackageTable
hsc_HPT
| Bool
otherwise = HomePackageTable
emptyHomePackageTable
in
$WHscEnv :: DynFlags
-> [Target]
-> ModuleGraph
-> InteractiveContext
-> HomePackageTable
-> IORef ExternalPackageState
-> IORef NameCache
-> IORef FinderCache
-> Maybe (Module, IORef TypeEnv)
-> MVar (Maybe IServ)
-> HscEnv
HscEnv { hsc_targets :: [Target]
hsc_targets = String -> [Target]
forall a. String -> a
panic "cleanTopEnv: hsc_targets"
, hsc_mod_graph :: ModuleGraph
hsc_mod_graph = String -> ModuleGraph
forall a. String -> a
panic "cleanTopEnv: hsc_mod_graph"
, hsc_IC :: InteractiveContext
hsc_IC = String -> InteractiveContext
forall a. String -> a
panic "cleanTopEnv: hsc_IC"
, hsc_HPT :: HomePackageTable
hsc_HPT = HomePackageTable
hpt
, .. }
(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 :: DynFlags -> ModIface -> Bool
is_external_sig :: DynFlags -> ModIface -> Bool
is_external_sig dflags :: DynFlags
dflags iface :: ModIface
iface =
ModIface -> Module
mi_semantic_module ModIface
iface Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
/= ModIface -> Module
mi_module ModIface
iface Bool -> Bool -> Bool
&&
Module -> UnitId
moduleUnitId (ModIface -> Module
mi_module ModIface
iface) UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
/= DynFlags -> UnitId
thisPackage DynFlags
dflags
computeInterface ::
SDoc -> IsBootInterface -> Module
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, FilePath))
computeInterface :: MsgDoc
-> Bool
-> Module
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
computeInterface doc_str :: MsgDoc
doc_str hi_boot_file :: Bool
hi_boot_file mod0 :: Module
mod0 = do
MASSERT( not (isHoleModule mod0) )
DynFlags
dflags <- IOEnv (Env gbl lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
case Module -> (InstalledModule, Maybe IndefModule)
splitModuleInsts Module
mod0 of
(imod :: InstalledModule
imod, Just indef :: IndefModule
indef) | Bool -> Bool
not (UnitId -> Bool
unitIdIsDefinite (DynFlags -> UnitId
thisPackage DynFlags
dflags)) -> do
MaybeErr MsgDoc (ModIface, String)
r <- MsgDoc
-> InstalledModule
-> Module
-> Bool
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall gbl lcl.
MsgDoc
-> InstalledModule
-> Module
-> Bool
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
findAndReadIface MsgDoc
doc_str InstalledModule
imod Module
mod0 Bool
hi_boot_file
case MaybeErr MsgDoc (ModIface, String)
r of
Succeeded (iface0 :: ModIface
iface0, path :: String
path) -> do
HscEnv
hsc_env <- TcRnIf gbl lcl HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
Either ErrorMessages ModIface
r <- IO (Either ErrorMessages ModIface)
-> IOEnv (Env gbl lcl) (Either ErrorMessages ModIface)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ErrorMessages ModIface)
-> IOEnv (Env gbl lcl) (Either ErrorMessages ModIface))
-> IO (Either ErrorMessages ModIface)
-> IOEnv (Env gbl lcl) (Either ErrorMessages ModIface)
forall a b. (a -> b) -> a -> b
$
HscEnv
-> [(ModuleName, Module)]
-> Maybe NameShape
-> ModIface
-> IO (Either ErrorMessages ModIface)
rnModIface HscEnv
hsc_env (IndefUnitId -> [(ModuleName, Module)]
indefUnitIdInsts (IndefModule -> IndefUnitId
indefModuleUnitId IndefModule
indef))
Maybe NameShape
forall a. Maybe a
Nothing ModIface
iface0
case Either ErrorMessages ModIface
r of
Right x :: ModIface
x -> MaybeErr MsgDoc (ModIface, String)
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return ((ModIface, String) -> MaybeErr MsgDoc (ModIface, String)
forall err val. val -> MaybeErr err val
Succeeded (ModIface
x, String
path))
Left errs :: ErrorMessages
errs -> IO (MaybeErr MsgDoc (ModIface, String))
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MaybeErr MsgDoc (ModIface, String))
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String)))
-> (ErrorMessages -> IO (MaybeErr MsgDoc (ModIface, String)))
-> ErrorMessages
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceError -> IO (MaybeErr MsgDoc (ModIface, String))
forall e a. Exception e => e -> IO a
throwIO (SourceError -> IO (MaybeErr MsgDoc (ModIface, String)))
-> (ErrorMessages -> SourceError)
-> ErrorMessages
-> IO (MaybeErr MsgDoc (ModIface, String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessages -> SourceError
mkSrcErr (ErrorMessages
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String)))
-> ErrorMessages
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall a b. (a -> b) -> a -> b
$ ErrorMessages
errs
Failed err :: MsgDoc
err -> MaybeErr MsgDoc (ModIface, String)
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc (ModIface, String)
forall err val. err -> MaybeErr err val
Failed MsgDoc
err)
(mod :: InstalledModule
mod, _) ->
MsgDoc
-> InstalledModule
-> Module
-> Bool
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall gbl lcl.
MsgDoc
-> InstalledModule
-> Module
-> Bool
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
findAndReadIface MsgDoc
doc_str InstalledModule
mod Module
mod0 Bool
hi_boot_file
moduleFreeHolesPrecise
:: SDoc -> Module
-> TcRnIf gbl lcl (MaybeErr MsgDoc (UniqDSet ModuleName))
moduleFreeHolesPrecise :: MsgDoc
-> Module -> TcRnIf gbl lcl (MaybeErr MsgDoc (UniqDSet ModuleName))
moduleFreeHolesPrecise doc_str :: MsgDoc
doc_str mod :: Module
mod
| Module -> Bool
moduleIsDefinite Module
mod = MaybeErr MsgDoc (UniqDSet ModuleName)
-> TcRnIf gbl lcl (MaybeErr MsgDoc (UniqDSet ModuleName))
forall (m :: * -> *) a. Monad m => a -> m a
return (UniqDSet ModuleName -> MaybeErr MsgDoc (UniqDSet ModuleName)
forall err val. val -> MaybeErr err val
Succeeded UniqDSet ModuleName
forall a. UniqDSet a
emptyUniqDSet)
| Bool
otherwise =
case Module -> (InstalledModule, Maybe IndefModule)
splitModuleInsts Module
mod of
(imod :: InstalledModule
imod, Just indef :: IndefModule
indef) -> do
let insts :: [(ModuleName, Module)]
insts = IndefUnitId -> [(ModuleName, Module)]
indefUnitIdInsts (IndefModule -> IndefUnitId
indefModuleUnitId IndefModule
indef)
MsgDoc -> TcRnIf gbl lcl ()
forall m n. MsgDoc -> TcRnIf m n ()
traceIf (String -> MsgDoc
text "Considering whether to load" MsgDoc -> MsgDoc -> MsgDoc
<+> Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Module
mod MsgDoc -> MsgDoc -> MsgDoc
<+>
String -> MsgDoc
text "to compute precise free module holes")
(eps :: ExternalPackageState
eps, hpt :: HomePackageTable
hpt) <- TcRnIf gbl lcl (ExternalPackageState, HomePackageTable)
forall gbl lcl.
TcRnIf gbl lcl (ExternalPackageState, HomePackageTable)
getEpsAndHpt
DynFlags
dflags <- IOEnv (Env gbl lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
case DynFlags
-> ExternalPackageState
-> HomePackageTable
-> Maybe (UniqDSet ModuleName)
tryEpsAndHpt DynFlags
dflags 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 r :: UniqDSet ModuleName
r -> MaybeErr MsgDoc (UniqDSet ModuleName)
-> TcRnIf gbl lcl (MaybeErr MsgDoc (UniqDSet ModuleName))
forall (m :: * -> *) a. Monad m => a -> m a
return (UniqDSet ModuleName -> MaybeErr MsgDoc (UniqDSet ModuleName)
forall err val. val -> MaybeErr err val
Succeeded UniqDSet ModuleName
r)
Nothing -> InstalledModule
-> [(ModuleName, Module)]
-> TcRnIf gbl lcl (MaybeErr MsgDoc (UniqDSet ModuleName))
forall gbl lcl.
InstalledModule
-> [(ModuleName, Module)]
-> IOEnv (Env gbl lcl) (MaybeErr MsgDoc (UniqDSet ModuleName))
readAndCache InstalledModule
imod [(ModuleName, Module)]
insts
(_, Nothing) -> MaybeErr MsgDoc (UniqDSet ModuleName)
-> TcRnIf gbl lcl (MaybeErr MsgDoc (UniqDSet ModuleName))
forall (m :: * -> *) a. Monad m => a -> m a
return (UniqDSet ModuleName -> MaybeErr MsgDoc (UniqDSet ModuleName)
forall err val. val -> MaybeErr err val
Succeeded UniqDSet ModuleName
forall a. UniqDSet a
emptyUniqDSet)
where
tryEpsAndHpt :: DynFlags
-> ExternalPackageState
-> HomePackageTable
-> Maybe (UniqDSet ModuleName)
tryEpsAndHpt dflags :: DynFlags
dflags eps :: ExternalPackageState
eps hpt :: 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 (DynFlags
-> HomePackageTable
-> PackageIfaceTable
-> Module
-> Maybe ModIface
lookupIfaceByModule DynFlags
dflags HomePackageTable
hpt (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) Module
mod)
tryDepsCache :: ExternalPackageState
-> InstalledModule
-> [(ModuleName, Module)]
-> Maybe (UniqDSet ModuleName)
tryDepsCache eps :: ExternalPackageState
eps imod :: InstalledModule
imod insts :: [(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 ifhs :: 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)
_otherwise :: Maybe (UniqDSet ModuleName)
_otherwise -> Maybe (UniqDSet ModuleName)
forall a. Maybe a
Nothing
readAndCache :: InstalledModule
-> [(ModuleName, Module)]
-> IOEnv (Env gbl lcl) (MaybeErr MsgDoc (UniqDSet ModuleName))
readAndCache imod :: InstalledModule
imod insts :: [(ModuleName, Module)]
insts = do
MaybeErr MsgDoc (ModIface, String)
mb_iface <- MsgDoc
-> InstalledModule
-> Module
-> Bool
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall gbl lcl.
MsgDoc
-> InstalledModule
-> Module
-> Bool
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
findAndReadIface (String -> MsgDoc
text "moduleFreeHolesPrecise" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
doc_str) InstalledModule
imod Module
mod Bool
False
case MaybeErr MsgDoc (ModIface, String)
mb_iface of
Succeeded (iface :: ModIface
iface, _) -> do
let ifhs :: UniqDSet ModuleName
ifhs = ModIface -> UniqDSet ModuleName
mi_free_holes ModIface
iface
(ExternalPackageState -> ExternalPackageState) -> TcRnIf gbl lcl ()
forall gbl lcl.
(ExternalPackageState -> ExternalPackageState) -> TcRnIf gbl lcl ()
updateEps_ (\eps :: 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 MsgDoc (UniqDSet ModuleName)
-> IOEnv (Env gbl lcl) (MaybeErr MsgDoc (UniqDSet ModuleName))
forall (m :: * -> *) a. Monad m => a -> m a
return (UniqDSet ModuleName -> MaybeErr MsgDoc (UniqDSet ModuleName)
forall err val. val -> MaybeErr err val
Succeeded (UniqDSet ModuleName
-> [(ModuleName, Module)] -> UniqDSet ModuleName
renameFreeHoles UniqDSet ModuleName
ifhs [(ModuleName, Module)]
insts))
Failed err :: MsgDoc
err -> MaybeErr MsgDoc (UniqDSet ModuleName)
-> IOEnv (Env gbl lcl) (MaybeErr MsgDoc (UniqDSet ModuleName))
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc (UniqDSet ModuleName)
forall err val. err -> MaybeErr err val
Failed MsgDoc
err)
wantHiBootFile :: DynFlags -> ExternalPackageState -> Module -> WhereFrom
-> MaybeErr MsgDoc IsBootInterface
wantHiBootFile :: DynFlags
-> ExternalPackageState
-> Module
-> WhereFrom
-> MaybeErr MsgDoc Bool
wantHiBootFile dflags :: DynFlags
dflags eps :: ExternalPackageState
eps mod :: Module
mod from :: WhereFrom
from
= case WhereFrom
from of
ImportByUser usr_boot :: Bool
usr_boot
| Bool
usr_boot Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
this_package
-> MsgDoc -> MaybeErr MsgDoc Bool
forall err val. err -> MaybeErr err val
Failed (Module -> MsgDoc
badSourceImport Module
mod)
| Bool
otherwise -> Bool -> MaybeErr MsgDoc Bool
forall err val. val -> MaybeErr err val
Succeeded Bool
usr_boot
ImportByPlugin
-> Bool -> MaybeErr MsgDoc Bool
forall err val. val -> MaybeErr err val
Succeeded Bool
False
ImportBySystem
| Bool -> Bool
not Bool
this_package
-> Bool -> MaybeErr MsgDoc Bool
forall err val. val -> MaybeErr err val
Succeeded Bool
False
| Bool
otherwise
-> case UniqFM (ModuleName, Bool) -> ModuleName -> Maybe (ModuleName, Bool)
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM (ExternalPackageState -> UniqFM (ModuleName, Bool)
eps_is_boot ExternalPackageState
eps) (Module -> ModuleName
moduleName Module
mod) of
Just (_, is_boot :: Bool
is_boot) -> Bool -> MaybeErr MsgDoc Bool
forall err val. val -> MaybeErr err val
Succeeded Bool
is_boot
Nothing -> Bool -> MaybeErr MsgDoc Bool
forall err val. val -> MaybeErr err val
Succeeded Bool
False
where
this_package :: Bool
this_package = DynFlags -> UnitId
thisPackage DynFlags
dflags UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> UnitId
moduleUnitId Module
mod
badSourceImport :: Module -> SDoc
badSourceImport :: Module -> MsgDoc
badSourceImport mod :: Module
mod
= MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text "You cannot {-# SOURCE #-} import a module from another package")
2 (String -> MsgDoc
text "but" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Module
mod) MsgDoc -> MsgDoc -> MsgDoc
<+> PtrString -> MsgDoc
ptext (String -> PtrString
sLit "is from package")
MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (UnitId -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Module -> UnitId
moduleUnitId Module
mod)))
addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
addDeclsToPTE :: TypeEnv -> [(Name, TyThing)] -> TypeEnv
addDeclsToPTE pte :: TypeEnv
pte things :: [(Name, TyThing)]
things = TypeEnv -> [(Name, TyThing)] -> TypeEnv
forall a. NameEnv a -> [(Name, a)] -> NameEnv a
extendNameEnvList TypeEnv
pte [(Name, TyThing)]
things
loadDecls :: Bool
-> [(Fingerprint, IfaceDecl)]
-> IfL [(Name,TyThing)]
loadDecls :: Bool -> [(Fingerprint, IfaceDecl)] -> IfL [(Name, TyThing)]
loadDecls ignore_prags :: Bool
ignore_prags ver_decls :: [(Fingerprint, IfaceDecl)]
ver_decls
= do { [[(Name, TyThing)]]
thingss <- ((Fingerprint, IfaceDecl) -> IfL [(Name, TyThing)])
-> [(Fingerprint, IfaceDecl)]
-> IOEnv (Env IfGblEnv IfLclEnv) [[(Name, TyThing)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> (Fingerprint, IfaceDecl) -> IfL [(Name, TyThing)]
loadDecl Bool
ignore_prags) [(Fingerprint, IfaceDecl)]
ver_decls
; [(Name, TyThing)] -> IfL [(Name, TyThing)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[(Name, TyThing)]] -> [(Name, TyThing)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Name, TyThing)]]
thingss)
}
loadDecl :: Bool
-> (Fingerprint, IfaceDecl)
-> IfL [(Name,TyThing)]
loadDecl :: Bool -> (Fingerprint, IfaceDecl) -> IfL [(Name, TyThing)]
loadDecl ignore_prags :: Bool
ignore_prags (_version :: Fingerprint
_version, decl :: IfaceDecl
decl)
= do {
let main_name :: Name
main_name = IfaceDecl -> Name
ifName IfaceDecl
decl
; TyThing
thing <- MsgDoc -> IfL TyThing -> IfL TyThing
forall a. MsgDoc -> IfL a -> IfL a
forkM MsgDoc
doc (IfL TyThing -> IfL TyThing) -> IfL TyThing -> IfL TyThing
forall a b. (a -> b) -> a -> b
$ do { Name -> IfL ()
bumpDeclStats Name
main_name
; Bool -> IfaceDecl -> IfL TyThing
tcIfaceDecl Bool
ignore_prags IfaceDecl
decl }
; let mini_env :: OccEnv TyThing
mini_env = [(OccName, TyThing)] -> OccEnv TyThing
forall a. [(OccName, a)] -> OccEnv a
mkOccEnv [(TyThing -> OccName
forall a. NamedThing a => a -> OccName
getOccName TyThing
t, TyThing
t) | TyThing
t <- TyThing -> [TyThing]
implicitTyThings TyThing
thing]
lookup :: a -> TyThing
lookup n :: a
n = case OccEnv TyThing -> OccName -> Maybe TyThing
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv TyThing
mini_env (a -> OccName
forall a. NamedThing a => a -> OccName
getOccName a
n) of
Just thing :: TyThing
thing -> TyThing
thing
Nothing ->
String -> MsgDoc -> TyThing
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic "loadDecl" (Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
main_name MsgDoc -> MsgDoc -> MsgDoc
<+> a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
n MsgDoc -> MsgDoc -> MsgDoc
$$ IfaceDecl -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (IfaceDecl
decl))
; [Name]
implicit_names <- (OccName -> IOEnv (Env IfGblEnv IfLclEnv) Name)
-> [OccName] -> IOEnv (Env IfGblEnv IfLclEnv) [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM OccName -> IOEnv (Env IfGblEnv IfLclEnv) Name
lookupIfaceTop (IfaceDecl -> [OccName]
ifaceDeclImplicitBndrs IfaceDecl
decl)
; [(Name, TyThing)] -> IfL [(Name, TyThing)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, TyThing)] -> IfL [(Name, TyThing)])
-> [(Name, TyThing)] -> IfL [(Name, TyThing)]
forall a b. (a -> b) -> a -> b
$ (Name
main_name, TyThing
thing) (Name, TyThing) -> [(Name, TyThing)] -> [(Name, TyThing)]
forall a. a -> [a] -> [a]
:
[(Name
n, Name -> TyThing
forall a. (NamedThing a, Outputable a) => a -> TyThing
lookup Name
n) | Name
n <- [Name]
implicit_names]
}
where
doc :: MsgDoc
doc = String -> MsgDoc
text "Declaration for" MsgDoc -> MsgDoc -> MsgDoc
<+> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (IfaceDecl -> Name
ifName IfaceDecl
decl)
bumpDeclStats :: Name -> IfL ()
bumpDeclStats :: Name -> IfL ()
bumpDeclStats name :: Name
name
= do { MsgDoc -> IfL ()
forall m n. MsgDoc -> TcRnIf m n ()
traceIf (String -> MsgDoc
text "Loading decl for" MsgDoc -> MsgDoc -> MsgDoc
<+> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
name)
; (ExternalPackageState -> ExternalPackageState) -> IfL ()
forall gbl lcl.
(ExternalPackageState -> ExternalPackageState) -> TcRnIf gbl lcl ()
updateEps_ (\eps :: ExternalPackageState
eps -> let stats :: EpsStats
stats = ExternalPackageState -> EpsStats
eps_stats ExternalPackageState
eps
in ExternalPackageState
eps { eps_stats :: EpsStats
eps_stats = EpsStats
stats { n_decls_out :: Int
n_decls_out = EpsStats -> Int
n_decls_out EpsStats
stats Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 } })
}
findAndReadIface :: SDoc
-> InstalledModule
-> Module
-> IsBootInterface
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, FilePath))
findAndReadIface :: MsgDoc
-> InstalledModule
-> Module
-> Bool
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
findAndReadIface doc_str :: MsgDoc
doc_str mod :: InstalledModule
mod wanted_mod_with_insts :: Module
wanted_mod_with_insts hi_boot_file :: Bool
hi_boot_file
= do MsgDoc -> TcRnIf gbl lcl ()
forall m n. MsgDoc -> TcRnIf m n ()
traceIf ([MsgDoc] -> MsgDoc
sep [[MsgDoc] -> MsgDoc
hsep [String -> MsgDoc
text "Reading",
if Bool
hi_boot_file
then String -> MsgDoc
text "[boot]"
else MsgDoc
Outputable.empty,
String -> MsgDoc
text "interface for",
InstalledModule -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr InstalledModule
mod MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
semi],
Int -> MsgDoc -> MsgDoc
nest 4 (String -> MsgDoc
text "reason:" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
doc_str)])
if InstalledModule
mod InstalledModule -> Module -> Bool
`installedModuleEq` Module
gHC_PRIM
then do
ModIface
iface <- (Hooks -> Maybe ModIface)
-> ModIface -> IOEnv (Env gbl lcl) ModIface
forall (f :: * -> *) a.
(Functor f, HasDynFlags f) =>
(Hooks -> Maybe a) -> a -> f a
getHooked Hooks -> Maybe ModIface
ghcPrimIfaceHook ModIface
ghcPrimIface
MaybeErr MsgDoc (ModIface, String)
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return ((ModIface, String) -> MaybeErr MsgDoc (ModIface, String)
forall err val. val -> MaybeErr err val
Succeeded (ModIface
iface,
"<built in interface for GHC.Prim>"))
else do
DynFlags
dflags <- IOEnv (Env gbl lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
HscEnv
hsc_env <- TcRnIf gbl lcl HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
InstalledFindResult
mb_found <- IO InstalledFindResult -> IOEnv (Env gbl lcl) InstalledFindResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> InstalledModule -> IO InstalledFindResult
findExactModule HscEnv
hsc_env InstalledModule
mod)
case InstalledFindResult
mb_found of
InstalledFound loc :: ModLocation
loc mod :: InstalledModule
mod -> do
let file_path :: String
file_path = Bool -> String -> String
addBootSuffix_maybe Bool
hi_boot_file
(ModLocation -> String
ml_hi_file ModLocation
loc)
if InstalledModule -> InstalledUnitId
installedModuleUnitId InstalledModule
mod InstalledUnitId -> UnitId -> Bool
`installedUnitIdEq` DynFlags -> UnitId
thisPackage DynFlags
dflags Bool -> Bool -> Bool
&&
Bool -> Bool
not (GhcMode -> Bool
isOneShot (DynFlags -> GhcMode
ghcMode DynFlags
dflags))
then MaybeErr MsgDoc (ModIface, String)
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc (ModIface, String)
forall err val. err -> MaybeErr err val
Failed (InstalledModule -> ModLocation -> MsgDoc
homeModError InstalledModule
mod ModLocation
loc))
else do MaybeErr MsgDoc (ModIface, String)
r <- String -> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall m n.
String -> IOEnv (Env m n) (MaybeErr MsgDoc (ModIface, String))
read_file String
file_path
MaybeErr MsgDoc (ModIface, String) -> TcRnIf gbl lcl ()
forall err gbl lcl.
MaybeErr err (ModIface, String) -> IOEnv (Env gbl lcl) ()
checkBuildDynamicToo MaybeErr MsgDoc (ModIface, String)
r
MaybeErr MsgDoc (ModIface, String)
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return MaybeErr MsgDoc (ModIface, String)
r
err :: InstalledFindResult
err -> do
MsgDoc -> TcRnIf gbl lcl ()
forall m n. MsgDoc -> TcRnIf m n ()
traceIf (String -> MsgDoc
text "...not found")
DynFlags
dflags <- IOEnv (Env gbl lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
MaybeErr MsgDoc (ModIface, String)
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc (ModIface, String)
forall err val. err -> MaybeErr err val
Failed (DynFlags -> ModuleName -> InstalledFindResult -> MsgDoc
cannotFindInterface DynFlags
dflags
(InstalledModule -> ModuleName
installedModuleName InstalledModule
mod) InstalledFindResult
err))
where read_file :: String -> IOEnv (Env m n) (MaybeErr MsgDoc (ModIface, String))
read_file file_path :: String
file_path = do
MsgDoc -> TcRnIf m n ()
forall m n. MsgDoc -> TcRnIf m n ()
traceIf (String -> MsgDoc
text "readIFace" MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
file_path)
DynFlags
dflags <- IOEnv (Env m n) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
let wanted_mod :: Module
wanted_mod =
case Module -> (InstalledModule, Maybe IndefModule)
splitModuleInsts Module
wanted_mod_with_insts of
(_, Nothing) -> Module
wanted_mod_with_insts
(_, Just indef_mod :: IndefModule
indef_mod) ->
DynFlags -> IndefModule -> Module
indefModuleToModule DynFlags
dflags
(IndefModule -> IndefModule
generalizeIndefModule IndefModule
indef_mod)
MaybeErr MsgDoc ModIface
read_result <- Module -> String -> TcRnIf m n (MaybeErr MsgDoc ModIface)
forall gbl lcl.
Module -> String -> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)
readIface Module
wanted_mod String
file_path
case MaybeErr MsgDoc ModIface
read_result of
Failed err :: MsgDoc
err -> MaybeErr MsgDoc (ModIface, String)
-> IOEnv (Env m n) (MaybeErr MsgDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc (ModIface, String)
forall err val. err -> MaybeErr err val
Failed (String -> MsgDoc -> MsgDoc
badIfaceFile String
file_path MsgDoc
err))
Succeeded iface :: ModIface
iface -> MaybeErr MsgDoc (ModIface, String)
-> IOEnv (Env m n) (MaybeErr MsgDoc (ModIface, String))
forall (m :: * -> *) a. Monad m => a -> m a
return ((ModIface, String) -> MaybeErr MsgDoc (ModIface, String)
forall err val. val -> MaybeErr err val
Succeeded (ModIface
iface, String
file_path))
checkBuildDynamicToo :: MaybeErr err (ModIface, String) -> IOEnv (Env gbl lcl) ()
checkBuildDynamicToo (Succeeded (iface :: ModIface
iface, filePath :: String
filePath)) = do
DynFlags
dflags <- IOEnv (Env gbl lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
let is_definite_iface :: Bool
is_definite_iface = Module -> Bool
moduleIsDefinite (ModIface -> Module
mi_module ModIface
iface)
Bool -> IOEnv (Env gbl lcl) () -> IOEnv (Env gbl lcl) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
is_definite_iface (IOEnv (Env gbl lcl) () -> IOEnv (Env gbl lcl) ())
-> IOEnv (Env gbl lcl) () -> IOEnv (Env gbl lcl) ()
forall a b. (a -> b) -> a -> b
$
DynFlags -> IOEnv (Env gbl lcl) () -> IOEnv (Env gbl lcl) ()
forall (m :: * -> *). MonadIO m => DynFlags -> m () -> m ()
whenGeneratingDynamicToo DynFlags
dflags (IOEnv (Env gbl lcl) () -> IOEnv (Env gbl lcl) ())
-> IOEnv (Env gbl lcl) () -> IOEnv (Env gbl lcl) ()
forall a b. (a -> b) -> a -> b
$ IOEnv (Env gbl lcl) () -> IOEnv (Env gbl lcl) ()
forall gbl lcl a. TcRnIf gbl lcl a -> TcRnIf gbl lcl a
withDoDynamicToo (IOEnv (Env gbl lcl) () -> IOEnv (Env gbl lcl) ())
-> IOEnv (Env gbl lcl) () -> IOEnv (Env gbl lcl) ()
forall a b. (a -> b) -> a -> b
$ do
let ref :: IORef Bool
ref = DynFlags -> IORef Bool
canGenerateDynamicToo DynFlags
dflags
dynFilePath :: String
dynFilePath = Bool -> String -> String
addBootSuffix_maybe Bool
hi_boot_file
(String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
replaceExtension String
filePath (DynFlags -> String
dynHiSuf DynFlags
dflags)
MaybeErr MsgDoc (ModIface, String)
r <- String -> IOEnv (Env gbl lcl) (MaybeErr MsgDoc (ModIface, String))
forall m n.
String -> IOEnv (Env m n) (MaybeErr MsgDoc (ModIface, String))
read_file String
dynFilePath
case MaybeErr MsgDoc (ModIface, String)
r of
Succeeded (dynIface :: ModIface
dynIface, _)
| ModIface -> Fingerprint
mi_mod_hash ModIface
iface Fingerprint -> Fingerprint -> Bool
forall a. Eq a => a -> a -> Bool
== ModIface -> Fingerprint
mi_mod_hash ModIface
dynIface ->
() -> IOEnv (Env gbl lcl) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise ->
do MsgDoc -> IOEnv (Env gbl lcl) ()
forall m n. MsgDoc -> TcRnIf m n ()
traceIf (String -> MsgDoc
text "Dynamic hash doesn't match")
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
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
ref Bool
False
Failed err :: MsgDoc
err ->
do MsgDoc -> IOEnv (Env gbl lcl) ()
forall m n. MsgDoc -> TcRnIf m n ()
traceIf (String -> MsgDoc
text "Failed to load dynamic interface file:" MsgDoc -> MsgDoc -> MsgDoc
$$ MsgDoc
err)
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
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
ref Bool
False
checkBuildDynamicToo _ = () -> IOEnv (Env gbl lcl) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
readIface :: Module -> FilePath
-> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)
readIface :: Module -> String -> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)
readIface wanted_mod :: Module
wanted_mod file_path :: String
file_path
= do { Either SomeException ModIface
res <- IOEnv (Env gbl lcl) ModIface
-> IOEnv (Env gbl lcl) (Either SomeException ModIface)
forall env r. IOEnv env r -> IOEnv env (Either SomeException r)
tryMostM (IOEnv (Env gbl lcl) ModIface
-> IOEnv (Env gbl lcl) (Either SomeException ModIface))
-> IOEnv (Env gbl lcl) ModIface
-> IOEnv (Env gbl lcl) (Either SomeException ModIface)
forall a b. (a -> b) -> a -> b
$
CheckHiWay
-> TraceBinIFaceReading -> String -> IOEnv (Env gbl lcl) ModIface
forall a b.
CheckHiWay -> TraceBinIFaceReading -> String -> TcRnIf a b ModIface
readBinIface CheckHiWay
CheckHiWay TraceBinIFaceReading
QuietBinIFaceReading String
file_path
; DynFlags
dflags <- IOEnv (Env gbl lcl) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; case Either SomeException ModIface
res of
Right iface :: ModIface
iface
| Module
wanted_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
actual_mod
-> MaybeErr MsgDoc ModIface
-> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModIface -> MaybeErr MsgDoc ModIface
forall err val. val -> MaybeErr err val
Succeeded ModIface
iface)
| Bool
otherwise -> MaybeErr MsgDoc ModIface
-> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc ModIface
forall err val. err -> MaybeErr err val
Failed MsgDoc
err)
where
actual_mod :: Module
actual_mod = ModIface -> Module
mi_module ModIface
iface
err :: MsgDoc
err = DynFlags -> Module -> Module -> MsgDoc
hiModuleNameMismatchWarn DynFlags
dflags Module
wanted_mod Module
actual_mod
Left exn :: SomeException
exn -> MaybeErr MsgDoc ModIface
-> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> MaybeErr MsgDoc ModIface
forall err val. err -> MaybeErr err val
Failed (String -> MsgDoc
text (SomeException -> String
forall e. Exception e => e -> String
showException SomeException
exn)))
}
initExternalPackageState :: ExternalPackageState
initExternalPackageState :: ExternalPackageState
initExternalPackageState
= $WEPS :: UniqFM (ModuleName, Bool)
-> PackageIfaceTable
-> InstalledModuleEnv (UniqDSet ModuleName)
-> TypeEnv
-> PackageInstEnv
-> PackageFamInstEnv
-> PackageRuleBase
-> PackageAnnEnv
-> PackageCompleteMatchMap
-> ModuleEnv PackageFamInstEnv
-> EpsStats
-> ExternalPackageState
EPS {
eps_is_boot :: UniqFM (ModuleName, Bool)
eps_is_boot = UniqFM (ModuleName, Bool)
forall elt. UniqFM 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 :: PackageCompleteMatchMap
eps_complete_matches = PackageCompleteMatchMap
forall elt. UniqFM elt
emptyUFM,
eps_ann_env :: PackageAnnEnv
eps_ann_env = PackageAnnEnv
emptyAnnEnv,
eps_stats :: EpsStats
eps_stats = $WEpsStats :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> EpsStats
EpsStats { n_ifaces_in :: Int
n_ifaces_in = 0, n_decls_in :: Int
n_decls_in = 0, n_decls_out :: Int
n_decls_out = 0
, n_insts_in :: Int
n_insts_in = 0, n_insts_out :: Int
n_insts_out = 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 = 0 }
}
ghcPrimIface :: ModIface
ghcPrimIface :: ModIface
ghcPrimIface
= (Module -> ModIface
emptyModIface Module
gHC_PRIM) {
mi_exports :: [IfaceExport]
mi_exports = [IfaceExport]
ghcPrimExports,
mi_decls :: [(Fingerprint, IfaceDecl)]
mi_decls = [],
mi_fixities :: [(OccName, Fixity)]
mi_fixities = [(OccName, Fixity)]
fixities,
mi_fix_fn :: OccName -> Maybe Fixity
mi_fix_fn = [(OccName, Fixity)] -> OccName -> Maybe Fixity
mkIfaceFixCache [(OccName, Fixity)]
fixities
}
where
fixities :: [(OccName, Fixity)]
fixities = (Id -> OccName
forall a. NamedThing a => a -> OccName
getOccName Id
seqId, SourceText -> Int -> FixityDirection -> Fixity
Fixity SourceText
NoSourceText 0 FixityDirection
InfixR)
(OccName, Fixity) -> [(OccName, Fixity)] -> [(OccName, Fixity)]
forall a. a -> [a] -> [a]
: (Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
funTyConName, Fixity
funTyFixity)
(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 op :: 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 -> MsgDoc
ifaceStats eps :: ExternalPackageState
eps
= [MsgDoc] -> MsgDoc
hcat [String -> MsgDoc
text "Renamer stats: ", MsgDoc
msg]
where
stats :: EpsStats
stats = ExternalPackageState -> EpsStats
eps_stats ExternalPackageState
eps
msg :: MsgDoc
msg = [MsgDoc] -> MsgDoc
vcat
[Int -> MsgDoc
int (EpsStats -> Int
n_ifaces_in EpsStats
stats) MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text "interfaces read",
[MsgDoc] -> MsgDoc
hsep [ Int -> MsgDoc
int (EpsStats -> Int
n_decls_out EpsStats
stats), String -> MsgDoc
text "type/class/variable imported, out of",
Int -> MsgDoc
int (EpsStats -> Int
n_decls_in EpsStats
stats), String -> MsgDoc
text "read"],
[MsgDoc] -> MsgDoc
hsep [ Int -> MsgDoc
int (EpsStats -> Int
n_insts_out EpsStats
stats), String -> MsgDoc
text "instance decls imported, out of",
Int -> MsgDoc
int (EpsStats -> Int
n_insts_in EpsStats
stats), String -> MsgDoc
text "read"],
[MsgDoc] -> MsgDoc
hsep [ Int -> MsgDoc
int (EpsStats -> Int
n_rules_out EpsStats
stats), String -> MsgDoc
text "rule decls imported, out of",
Int -> MsgDoc
int (EpsStats -> Int
n_rules_in EpsStats
stats), String -> MsgDoc
text "read"]
]
showIface :: HscEnv -> FilePath -> IO ()
showIface :: HscEnv -> String -> IO ()
showIface hsc_env :: HscEnv
hsc_env filename :: String
filename = do
ModIface
iface <- Char -> HscEnv -> () -> () -> TcRnIf () () ModIface -> IO ModIface
forall gbl lcl a.
Char -> HscEnv -> gbl -> lcl -> TcRnIf gbl lcl a -> IO a
initTcRnIf 's' HscEnv
hsc_env () () (TcRnIf () () ModIface -> IO ModIface)
-> TcRnIf () () ModIface -> IO ModIface
forall a b. (a -> b) -> a -> b
$
CheckHiWay
-> TraceBinIFaceReading -> String -> TcRnIf () () ModIface
forall a b.
CheckHiWay -> TraceBinIFaceReading -> String -> TcRnIf a b ModIface
readBinIface CheckHiWay
IgnoreHiWay TraceBinIFaceReading
TraceBinIFaceReading String
filename
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
qualifyImportedNames :: Module -> p -> QualifyName
qualifyImportedNames mod :: Module
mod _
| Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== ModIface -> Module
mi_module ModIface
iface = QualifyName
NameUnqual
| Bool
otherwise = QualifyName
NameNotInScope1
print_unqual :: PrintUnqualified
print_unqual = QueryQualifyName
-> (Module -> Bool) -> (UnitId -> Bool) -> PrintUnqualified
QueryQualify QueryQualifyName
forall p. Module -> p -> QualifyName
qualifyImportedNames
Module -> Bool
neverQualifyModules
UnitId -> Bool
neverQualifyPackages
DynFlags
-> WarnReason -> Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO ()
putLogMsg DynFlags
dflags WarnReason
NoReason Severity
SevDump SrcSpan
noSrcSpan
(DynFlags -> PrintUnqualified -> PprStyle
mkDumpStyle DynFlags
dflags PrintUnqualified
print_unqual) (ModIface -> MsgDoc
pprModIface ModIface
iface)
pprModIfaceSimple :: ModIface -> SDoc
pprModIfaceSimple :: ModIface -> MsgDoc
pprModIfaceSimple iface :: ModIface
iface = Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> Module
mi_module ModIface
iface) MsgDoc -> MsgDoc -> MsgDoc
$$ Dependencies -> MsgDoc
pprDeps (ModIface -> Dependencies
mi_deps ModIface
iface) MsgDoc -> MsgDoc -> MsgDoc
$$ Int -> MsgDoc -> MsgDoc
nest 2 ([MsgDoc] -> MsgDoc
vcat ((IfaceExport -> MsgDoc) -> [IfaceExport] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceExport -> MsgDoc
pprExport (ModIface -> [IfaceExport]
mi_exports ModIface
iface)))
pprModIface :: ModIface -> SDoc
pprModIface :: ModIface -> MsgDoc
pprModIface iface :: ModIface
iface
= [MsgDoc] -> MsgDoc
vcat [ String -> MsgDoc
text "interface"
MsgDoc -> MsgDoc -> MsgDoc
<+> Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> Module
mi_module ModIface
iface) MsgDoc -> MsgDoc -> MsgDoc
<+> HscSource -> MsgDoc
pp_hsc_src (ModIface -> HscSource
mi_hsc_src ModIface
iface)
MsgDoc -> MsgDoc -> MsgDoc
<+> (if ModIface -> Bool
mi_orphan ModIface
iface then String -> MsgDoc
text "[orphan module]" else MsgDoc
Outputable.empty)
MsgDoc -> MsgDoc -> MsgDoc
<+> (if ModIface -> Bool
mi_finsts ModIface
iface then String -> MsgDoc
text "[family instance module]" else MsgDoc
Outputable.empty)
MsgDoc -> MsgDoc -> MsgDoc
<+> (if ModIface -> Bool
mi_hpc ModIface
iface then String -> MsgDoc
text "[hpc]" else MsgDoc
Outputable.empty)
MsgDoc -> MsgDoc -> MsgDoc
<+> Integer -> MsgDoc
integer Integer
hiVersion
, Int -> MsgDoc -> MsgDoc
nest 2 (String -> MsgDoc
text "interface hash:" MsgDoc -> MsgDoc -> MsgDoc
<+> Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> Fingerprint
mi_iface_hash ModIface
iface))
, Int -> MsgDoc -> MsgDoc
nest 2 (String -> MsgDoc
text "ABI hash:" MsgDoc -> MsgDoc -> MsgDoc
<+> Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> Fingerprint
mi_mod_hash ModIface
iface))
, Int -> MsgDoc -> MsgDoc
nest 2 (String -> MsgDoc
text "export-list hash:" MsgDoc -> MsgDoc -> MsgDoc
<+> Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> Fingerprint
mi_exp_hash ModIface
iface))
, Int -> MsgDoc -> MsgDoc
nest 2 (String -> MsgDoc
text "orphan hash:" MsgDoc -> MsgDoc -> MsgDoc
<+> Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> Fingerprint
mi_orphan_hash ModIface
iface))
, Int -> MsgDoc -> MsgDoc
nest 2 (String -> MsgDoc
text "flag hash:" MsgDoc -> MsgDoc -> MsgDoc
<+> Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> Fingerprint
mi_flag_hash ModIface
iface))
, Int -> MsgDoc -> MsgDoc
nest 2 (String -> MsgDoc
text "opt_hash:" MsgDoc -> MsgDoc -> MsgDoc
<+> Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> Fingerprint
mi_opt_hash ModIface
iface))
, Int -> MsgDoc -> MsgDoc
nest 2 (String -> MsgDoc
text "hpc_hash:" MsgDoc -> MsgDoc -> MsgDoc
<+> Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> Fingerprint
mi_hpc_hash ModIface
iface))
, Int -> MsgDoc -> MsgDoc
nest 2 (String -> MsgDoc
text "plugin_hash:" MsgDoc -> MsgDoc -> MsgDoc
<+> Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> Fingerprint
mi_plugin_hash ModIface
iface))
, Int -> MsgDoc -> MsgDoc
nest 2 (String -> MsgDoc
text "sig of:" MsgDoc -> MsgDoc -> MsgDoc
<+> Maybe Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> Maybe Module
mi_sig_of ModIface
iface))
, Int -> MsgDoc -> MsgDoc
nest 2 (String -> MsgDoc
text "used TH splices:" MsgDoc -> MsgDoc -> MsgDoc
<+> Bool -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> Bool
mi_used_th ModIface
iface))
, Int -> MsgDoc -> MsgDoc
nest 2 (String -> MsgDoc
text "where")
, String -> MsgDoc
text "exports:"
, Int -> MsgDoc -> MsgDoc
nest 2 ([MsgDoc] -> MsgDoc
vcat ((IfaceExport -> MsgDoc) -> [IfaceExport] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceExport -> MsgDoc
pprExport (ModIface -> [IfaceExport]
mi_exports ModIface
iface)))
, Dependencies -> MsgDoc
pprDeps (ModIface -> Dependencies
mi_deps ModIface
iface)
, [MsgDoc] -> MsgDoc
vcat ((Usage -> MsgDoc) -> [Usage] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map Usage -> MsgDoc
pprUsage (ModIface -> [Usage]
mi_usages ModIface
iface))
, [MsgDoc] -> MsgDoc
vcat ((IfaceAnnotation -> MsgDoc) -> [IfaceAnnotation] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceAnnotation -> MsgDoc
pprIfaceAnnotation (ModIface -> [IfaceAnnotation]
mi_anns ModIface
iface))
, [(OccName, Fixity)] -> MsgDoc
pprFixities (ModIface -> [(OccName, Fixity)]
mi_fixities ModIface
iface)
, [MsgDoc] -> MsgDoc
vcat [Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Fingerprint
ver MsgDoc -> MsgDoc -> MsgDoc
$$ Int -> MsgDoc -> MsgDoc
nest 2 (IfaceDecl -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr IfaceDecl
decl) | (ver :: Fingerprint
ver,decl :: IfaceDecl
decl) <- ModIface -> [(Fingerprint, IfaceDecl)]
mi_decls ModIface
iface]
, [MsgDoc] -> MsgDoc
vcat ((IfaceClsInst -> MsgDoc) -> [IfaceClsInst] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceClsInst -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> [IfaceClsInst]
mi_insts ModIface
iface))
, [MsgDoc] -> MsgDoc
vcat ((IfaceFamInst -> MsgDoc) -> [IfaceFamInst] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceFamInst -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> [IfaceFamInst]
mi_fam_insts ModIface
iface))
, [MsgDoc] -> MsgDoc
vcat ((IfaceRule -> MsgDoc) -> [IfaceRule] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceRule -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> [IfaceRule]
mi_rules ModIface
iface))
, Warnings -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> Warnings
mi_warns ModIface
iface)
, IfaceTrustInfo -> MsgDoc
pprTrustInfo (ModIface -> IfaceTrustInfo
mi_trust ModIface
iface)
, Bool -> MsgDoc
pprTrustPkg (ModIface -> Bool
mi_trust_pkg ModIface
iface)
, [MsgDoc] -> MsgDoc
vcat ((IfaceCompleteMatch -> MsgDoc) -> [IfaceCompleteMatch] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceCompleteMatch -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> [IfaceCompleteMatch]
mi_complete_sigs ModIface
iface))
, String -> MsgDoc
text "module header:" MsgDoc -> MsgDoc -> MsgDoc
$$ Int -> MsgDoc -> MsgDoc
nest 2 (Maybe HsDocString -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> Maybe HsDocString
mi_doc_hdr ModIface
iface))
, String -> MsgDoc
text "declaration docs:" MsgDoc -> MsgDoc -> MsgDoc
$$ Int -> MsgDoc -> MsgDoc
nest 2 (DeclDocMap -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> DeclDocMap
mi_decl_docs ModIface
iface))
, String -> MsgDoc
text "arg docs:" MsgDoc -> MsgDoc -> MsgDoc
$$ Int -> MsgDoc -> MsgDoc
nest 2 (ArgDocMap -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (ModIface -> ArgDocMap
mi_arg_docs ModIface
iface))
]
where
pp_hsc_src :: HscSource -> MsgDoc
pp_hsc_src HsBootFile = String -> MsgDoc
text "[boot]"
pp_hsc_src HsigFile = String -> MsgDoc
text "[hsig]"
pp_hsc_src HsSrcFile = MsgDoc
Outputable.empty
pprExport :: IfaceExport -> SDoc
pprExport :: IfaceExport -> MsgDoc
pprExport (Avail n :: Name
n) = Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
n
pprExport (AvailTC _ [] []) = MsgDoc
Outputable.empty
pprExport (AvailTC n :: Name
n ns0 :: [Name]
ns0 fs :: [FieldLabel]
fs)
= case [Name]
ns0 of
(n' :: Name
n':ns :: [Name]
ns) | Name
nName -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==Name
n' -> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
n MsgDoc -> MsgDoc -> MsgDoc
<> [Name] -> [FieldLabel] -> MsgDoc
forall a a. Outputable a => [a] -> [FieldLbl a] -> MsgDoc
pp_export [Name]
ns [FieldLabel]
fs
_ -> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
n MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
vbar MsgDoc -> MsgDoc -> MsgDoc
<> [Name] -> [FieldLabel] -> MsgDoc
forall a a. Outputable a => [a] -> [FieldLbl a] -> MsgDoc
pp_export [Name]
ns0 [FieldLabel]
fs
where
pp_export :: [a] -> [FieldLbl a] -> MsgDoc
pp_export [] [] = MsgDoc
Outputable.empty
pp_export names :: [a]
names fs :: [FieldLbl a]
fs = MsgDoc -> MsgDoc
braces ([MsgDoc] -> MsgDoc
hsep ((a -> MsgDoc) -> [a] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [a]
names [MsgDoc] -> [MsgDoc] -> [MsgDoc]
forall a. [a] -> [a] -> [a]
++ (FieldLbl a -> MsgDoc) -> [FieldLbl a] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FastString -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (FastString -> MsgDoc)
-> (FieldLbl a -> FastString) -> FieldLbl a -> MsgDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLbl a -> FastString
forall a. FieldLbl a -> FastString
flLabel) [FieldLbl a]
fs))
pprUsage :: Usage -> SDoc
pprUsage :: Usage -> MsgDoc
pprUsage usage :: Usage
usage@UsagePackageModule{}
= Usage -> (Usage -> Module) -> MsgDoc
forall a. Outputable a => Usage -> (Usage -> a) -> MsgDoc
pprUsageImport Usage
usage Usage -> Module
usg_mod
pprUsage usage :: Usage
usage@UsageHomeModule{}
= Usage -> (Usage -> ModuleName) -> MsgDoc
forall a. Outputable a => Usage -> (Usage -> a) -> MsgDoc
pprUsageImport Usage
usage Usage -> ModuleName
usg_mod_name MsgDoc -> MsgDoc -> MsgDoc
$$
Int -> MsgDoc -> MsgDoc
nest 2 (
MsgDoc -> (Fingerprint -> MsgDoc) -> Maybe Fingerprint -> MsgDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MsgDoc
Outputable.empty (\v :: Fingerprint
v -> String -> MsgDoc
text "exports: " MsgDoc -> MsgDoc -> MsgDoc
<> Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Fingerprint
v) (Usage -> Maybe Fingerprint
usg_exports Usage
usage) MsgDoc -> MsgDoc -> MsgDoc
$$
[MsgDoc] -> MsgDoc
vcat [ OccName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr OccName
n MsgDoc -> MsgDoc -> MsgDoc
<+> Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Fingerprint
v | (n :: OccName
n,v :: Fingerprint
v) <- Usage -> [(OccName, Fingerprint)]
usg_entities Usage
usage ]
)
pprUsage usage :: Usage
usage@UsageFile{}
= [MsgDoc] -> MsgDoc
hsep [String -> MsgDoc
text "addDependentFile",
MsgDoc -> MsgDoc
doubleQuotes (String -> MsgDoc
text (Usage -> String
usg_file_path Usage
usage)),
Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Usage -> Fingerprint
usg_file_hash Usage
usage)]
pprUsage usage :: Usage
usage@UsageMergedRequirement{}
= [MsgDoc] -> MsgDoc
hsep [String -> MsgDoc
text "merged", Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Usage -> Module
usg_mod Usage
usage), Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Usage -> Fingerprint
usg_mod_hash Usage
usage)]
pprUsageImport :: Outputable a => Usage -> (Usage -> a) -> SDoc
pprUsageImport :: Usage -> (Usage -> a) -> MsgDoc
pprUsageImport usage :: Usage
usage usg_mod' :: Usage -> a
usg_mod'
= [MsgDoc] -> MsgDoc
hsep [String -> MsgDoc
text "import", MsgDoc
safe, a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Usage -> a
usg_mod' Usage
usage),
Fingerprint -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Usage -> Fingerprint
usg_mod_hash Usage
usage)]
where
safe :: MsgDoc
safe | Usage -> Bool
usg_safe Usage
usage = String -> MsgDoc
text "safe"
| Bool
otherwise = String -> MsgDoc
text " -/ "
pprDeps :: Dependencies -> SDoc
pprDeps :: Dependencies -> MsgDoc
pprDeps (Deps { dep_mods :: Dependencies -> [(ModuleName, Bool)]
dep_mods = [(ModuleName, Bool)]
mods, dep_pkgs :: Dependencies -> [(InstalledUnitId, Bool)]
dep_pkgs = [(InstalledUnitId, Bool)]
pkgs, dep_orphs :: Dependencies -> [Module]
dep_orphs = [Module]
orphs,
dep_finsts :: Dependencies -> [Module]
dep_finsts = [Module]
finsts })
= [MsgDoc] -> MsgDoc
vcat [String -> MsgDoc
text "module dependencies:" MsgDoc -> MsgDoc -> MsgDoc
<+> [MsgDoc] -> MsgDoc
fsep (((ModuleName, Bool) -> MsgDoc) -> [(ModuleName, Bool)] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, Bool) -> MsgDoc
forall a. Outputable a => (a, Bool) -> MsgDoc
ppr_mod [(ModuleName, Bool)]
mods),
String -> MsgDoc
text "package dependencies:" MsgDoc -> MsgDoc -> MsgDoc
<+> [MsgDoc] -> MsgDoc
fsep (((InstalledUnitId, Bool) -> MsgDoc)
-> [(InstalledUnitId, Bool)] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map (InstalledUnitId, Bool) -> MsgDoc
forall a. Outputable a => (a, Bool) -> MsgDoc
ppr_pkg [(InstalledUnitId, Bool)]
pkgs),
String -> MsgDoc
text "orphans:" MsgDoc -> MsgDoc -> MsgDoc
<+> [MsgDoc] -> MsgDoc
fsep ((Module -> MsgDoc) -> [Module] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [Module]
orphs),
String -> MsgDoc
text "family instance modules:" MsgDoc -> MsgDoc -> MsgDoc
<+> [MsgDoc] -> MsgDoc
fsep ((Module -> MsgDoc) -> [Module] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [Module]
finsts)
]
where
ppr_mod :: (a, Bool) -> MsgDoc
ppr_mod (mod_name :: a
mod_name, boot :: Bool
boot) = a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
mod_name MsgDoc -> MsgDoc -> MsgDoc
<+> Bool -> MsgDoc
ppr_boot Bool
boot
ppr_pkg :: (a, Bool) -> MsgDoc
ppr_pkg (pkg :: a
pkg,trust_req :: Bool
trust_req) = a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
pkg MsgDoc -> MsgDoc -> MsgDoc
<>
(if Bool
trust_req then String -> MsgDoc
text "*" else MsgDoc
Outputable.empty)
ppr_boot :: Bool -> MsgDoc
ppr_boot True = String -> MsgDoc
text "[boot]"
ppr_boot False = MsgDoc
Outputable.empty
pprFixities :: [(OccName, Fixity)] -> SDoc
pprFixities :: [(OccName, Fixity)] -> MsgDoc
pprFixities [] = MsgDoc
Outputable.empty
pprFixities fixes :: [(OccName, Fixity)]
fixes = String -> MsgDoc
text "fixities" MsgDoc -> MsgDoc -> MsgDoc
<+> ((OccName, Fixity) -> MsgDoc) -> [(OccName, Fixity)] -> MsgDoc
forall a. (a -> MsgDoc) -> [a] -> MsgDoc
pprWithCommas (OccName, Fixity) -> MsgDoc
forall a a. (Outputable a, Outputable a) => (a, a) -> MsgDoc
pprFix [(OccName, Fixity)]
fixes
where
pprFix :: (a, a) -> MsgDoc
pprFix (occ :: a
occ,fix :: a
fix) = a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
fix MsgDoc -> MsgDoc -> MsgDoc
<+> a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
occ
pprTrustInfo :: IfaceTrustInfo -> SDoc
pprTrustInfo :: IfaceTrustInfo -> MsgDoc
pprTrustInfo trust :: IfaceTrustInfo
trust = String -> MsgDoc
text "trusted:" MsgDoc -> MsgDoc -> MsgDoc
<+> IfaceTrustInfo -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr IfaceTrustInfo
trust
pprTrustPkg :: Bool -> SDoc
pprTrustPkg :: Bool -> MsgDoc
pprTrustPkg tpkg :: Bool
tpkg = String -> MsgDoc
text "require own pkg trusted:" MsgDoc -> MsgDoc -> MsgDoc
<+> Bool -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Bool
tpkg
instance Outputable Warnings where
ppr :: Warnings -> MsgDoc
ppr = Warnings -> MsgDoc
pprWarns
pprWarns :: Warnings -> SDoc
pprWarns :: Warnings -> MsgDoc
pprWarns NoWarnings = MsgDoc
Outputable.empty
pprWarns (WarnAll txt :: WarningTxt
txt) = String -> MsgDoc
text "Warn all" MsgDoc -> MsgDoc -> MsgDoc
<+> WarningTxt -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr WarningTxt
txt
pprWarns (WarnSome prs :: [(OccName, WarningTxt)]
prs) = String -> MsgDoc
text "Warnings"
MsgDoc -> MsgDoc -> MsgDoc
<+> [MsgDoc] -> MsgDoc
vcat (((OccName, WarningTxt) -> MsgDoc)
-> [(OccName, WarningTxt)] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map (OccName, WarningTxt) -> MsgDoc
forall a a. (Outputable a, Outputable a) => (a, a) -> MsgDoc
pprWarning [(OccName, WarningTxt)]
prs)
where pprWarning :: (a, a) -> MsgDoc
pprWarning (name :: a
name, txt :: a
txt) = a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
name MsgDoc -> MsgDoc -> MsgDoc
<+> a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
txt
pprIfaceAnnotation :: IfaceAnnotation -> SDoc
pprIfaceAnnotation :: IfaceAnnotation -> MsgDoc
pprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget :: IfaceAnnotation -> IfaceAnnTarget
ifAnnotatedTarget = IfaceAnnTarget
target, ifAnnotatedValue :: IfaceAnnotation -> AnnPayload
ifAnnotatedValue = AnnPayload
serialized })
= IfaceAnnTarget -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr IfaceAnnTarget
target MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text "annotated by" MsgDoc -> MsgDoc -> MsgDoc
<+> AnnPayload -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr AnnPayload
serialized
badIfaceFile :: String -> SDoc -> SDoc
badIfaceFile :: String -> MsgDoc -> MsgDoc
badIfaceFile file :: String
file err :: MsgDoc
err
= [MsgDoc] -> MsgDoc
vcat [String -> MsgDoc
text "Bad interface file:" MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
file,
Int -> MsgDoc -> MsgDoc
nest 4 MsgDoc
err]
hiModuleNameMismatchWarn :: DynFlags -> Module -> Module -> MsgDoc
hiModuleNameMismatchWarn :: DynFlags -> Module -> Module -> MsgDoc
hiModuleNameMismatchWarn dflags :: DynFlags
dflags requested_mod :: Module
requested_mod read_mod :: Module
read_mod
| Module -> UnitId
moduleUnitId Module
requested_mod UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> UnitId
moduleUnitId Module
read_mod =
[MsgDoc] -> MsgDoc
sep [String -> MsgDoc
text "Interface file contains module" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Module
read_mod) MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
comma,
String -> MsgDoc
text "but we were expecting module" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Module
requested_mod),
[MsgDoc] -> MsgDoc
sep [String -> MsgDoc
text "Probable cause: the source code which generated interface file",
String -> MsgDoc
text "has an incompatible module name"
]
]
| Bool
otherwise =
PprStyle -> MsgDoc -> MsgDoc
withPprStyle (DynFlags -> PrintUnqualified -> Depth -> PprStyle
mkUserStyle DynFlags
dflags PrintUnqualified
alwaysQualify Depth
AllTheWay) (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
forall a b. (a -> b) -> a -> b
$
[MsgDoc] -> MsgDoc
hsep [ String -> MsgDoc
text "Something is amiss; requested module "
, Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Module
requested_mod
, String -> MsgDoc
text "differs from name found in the interface file"
, Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Module
read_mod
, MsgDoc -> MsgDoc
parens (String -> MsgDoc
text "if these names look the same, try again with -dppr-debug")
]
homeModError :: InstalledModule -> ModLocation -> SDoc
homeModError :: InstalledModule -> ModLocation -> MsgDoc
homeModError mod :: InstalledModule
mod location :: ModLocation
location
= String -> MsgDoc
text "attempting to use module " MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc -> MsgDoc
quotes (InstalledModule -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr InstalledModule
mod)
MsgDoc -> MsgDoc -> MsgDoc
<> (case ModLocation -> Maybe String
ml_hs_file ModLocation
location of
Just file :: String
file -> MsgDoc
space MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc -> MsgDoc
parens (String -> MsgDoc
text String
file)
Nothing -> MsgDoc
Outputable.empty)
MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text "which is not loaded"