\begin{code}
module LoadIface (
- loadHomeInterface, loadInterface,
+ loadHomeInterface, loadInterface, loadDecls,
loadSrcInterface, loadOrphanModules, loadHiBootInterface,
readIface, -- Used when reading the module's old interface
predInstGates, ifaceInstGates, ifaceStats, discardDeclPrags,
import {-# SOURCE #-} TcIface( tcIfaceDecl )
import Packages ( PackageState(..), PackageIdH(..), isHomePackage )
-import DriverState ( v_GhcMode, isCompManagerMode )
-import CmdLineOpts ( DynFlags(..), DynFlag( Opt_IgnoreInterfacePragmas ) )
+import DynFlags ( DynFlags(..), DynFlag( Opt_IgnoreInterfacePragmas ),
+ isOneShot )
import IfaceSyn ( IfaceDecl(..), IfaceConDecl(..), IfaceClassOp(..),
IfaceConDecls(..), IfaceInst(..), IfaceRule(..),
IfaceExpr(..), IfaceTyCon(..), IfaceIdInfo(..),
IfaceType(..), IfacePredType(..), IfaceExtName,
mkIfaceExtName )
-import IfaceEnv ( newGlobalBinder, lookupIfaceExt, lookupIfaceTc,
- lookupOrig )
+import IfaceEnv ( newGlobalBinder, lookupIfaceExt, lookupIfaceTc, lookupAvail )
import HscTypes ( ModIface(..), TyThing, emptyModIface, EpsStats(..),
addEpsInStats, ExternalPackageState(..),
- PackageTypeEnv, emptyTypeEnv,
+ PackageTypeEnv, emptyTypeEnv, HscEnv(..),
lookupIfaceByModule, emptyPackageIfaceTable,
IsBootInterface, mkIfaceFixCache, Gated,
- implicitTyThings, addRulesToPool, addInstsToPool,
- availNames
+ implicitTyThings, addRulesToPool, addInstsToPool
)
import BasicTypes ( Version, Fixity(..), FixityDirection(..),
do { -- Load it (into the PTE), and return the exported names
iface <- loadSrcInterface (mk_doc mod_nm) mod_nm True
- ; sequenceM [ lookupOrig mod_nm occ
- | (mod,avails) <- mi_exports iface,
- avail <- avails, occ <- availNames avail]
+ ; ns_s <- sequenceM [ lookupAvail mod_nm avail
+ | (mod,avails) <- mi_exports iface,
+ avail <- avails ]
+ ; return (concat ns_s)
}}}
where
mk_doc mod = ptext SLIT("Need the hi-boot interface for") <+> ppr mod
-- explicitly tag each export which seems a bit of a bore)
; ignore_prags <- doptM Opt_IgnoreInterfacePragmas
- ; new_eps_decls <- mapM (loadDecl ignore_prags) (mi_decls iface)
- ; new_eps_insts <- mapM loadInst (mi_insts iface)
+ ; new_eps_decls <- loadDecls ignore_prags (mi_decls iface)
+ ; new_eps_insts <- mapM loadInst (mi_insts iface)
; new_eps_rules <- if ignore_prags
then return []
else mapM loadRule (mi_rules iface)
-- the declaration itself, will find the fully-glorious Name
-----------------------------------------------------
-addDeclsToPTE :: PackageTypeEnv -> [[(Name,TyThing)]] -> PackageTypeEnv
-addDeclsToPTE pte things = foldl extendNameEnvList pte things
+addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
+addDeclsToPTE pte things = extendNameEnvList pte things
+
+loadDecls :: Bool
+ -> [(Version, IfaceDecl)]
+ -> IfL [(Name,TyThing)]
+loadDecls ignore_prags ver_decls
+ = do { mod <- getIfModule
+ ; thingss <- mapM (loadDecl ignore_prags mod) ver_decls
+ ; return (concat thingss)
+ }
loadDecl :: Bool -- Don't load pragmas into the decl pool
+ -> Module
-> (Version, IfaceDecl)
-> IfL [(Name,TyThing)] -- The list can be poked eagerly, but the
-- TyThings are forkM'd thunks
-loadDecl ignore_prags (_version, decl)
+loadDecl ignore_prags mod (_version, decl)
= do { -- Populate the name cache with final versions of all
-- the names associated with the decl
- mod <- getIfModule
- ; main_name <- mk_new_bndr mod Nothing (ifName decl)
+ main_name <- mk_new_bndr mod Nothing (ifName decl)
; implicit_names <- mapM (mk_new_bndr mod (Just main_name)) (ifaceDeclSubBndrs decl)
-- Typecheck the thing, lazily
+ -- NB. firstly, the laziness is there in case we never need the
+ -- declaration (in one-shot mode), and secondly it is there so that
+ -- we don't look up the occurrence of a name before calling mk_new_bndr
+ -- on the binder. This is important because we must get the right name
+ -- which includes its nameParent.
; thing <- forkM doc (bumpDeclStats main_name >> tcIfaceDecl stripped_decl)
; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
lookup n = case lookupOccEnv mini_env (getOccName n) of
ifaceInstGates (IfaceForAllTy _ t) = ifaceInstGates t
ifaceInstGates (IfaceFunTy _ t) = ifaceInstGates t
-ifaceInstGates (IfacePredTy (IfaceClassP cls tys)) = instHeadGates cls tys
+ifaceInstGates (IfacePredTy (IfaceClassP cls tys)) = (cls, instHeadTyconGates tys)
ifaceInstGates other = pprPanic "ifaceInstGates" (ppr other)
-- The other cases should not happen
-instHeadGates cls tys = (cls, mapCatMaybes root_tycon tys)
+instHeadTyconGates tys = mapCatMaybes root_tycon tys
where
root_tycon (IfaceFunTy _ _) = Just (IfaceTc funTyConExtName)
root_tycon (IfaceTyConApp tc _) = Just tc
else do
-- Look for the file
- ; mb_found <- ioToIOEnv (findHiFile dflags explicit mod_name hi_boot_file)
+ ; hsc_env <- getTopEnv
+ ; mb_found <- ioToIOEnv (findHiFile hsc_env explicit mod_name hi_boot_file)
; case mb_found of {
Failed err -> do
{ traceIf (ptext SLIT("...not found"))
-- Don't forget to fill in the package name...
}}}
-findHiFile :: DynFlags -> Bool -> Module -> IsBootInterface
+findHiFile :: HscEnv -> Bool -> Module -> IsBootInterface
-> IO (MaybeErr FindResult (FilePath, PackageIdH))
-findHiFile dflags explicit mod_name hi_boot_file
+findHiFile hsc_env explicit mod_name hi_boot_file
= do {
-- In interactive or --make mode, we are *not allowed* to demand-load
-- a home package .hi file. So don't even look for them.
-- This helps in the case where you are sitting in eg. ghc/lib/std
-- and start up GHCi - it won't complain that all the modules it tries
-- to load are found in the home location.
- ghci_mode <- readIORef v_GhcMode ;
- let { home_allowed = not (isCompManagerMode ghci_mode) } ;
+ let { home_allowed = isOneShot (ghcMode (hsc_dflags hsc_env)) } ;
maybe_found <- if home_allowed
- then findModule dflags mod_name explicit
- else findPackageModule dflags mod_name explicit;
+ then findModule hsc_env mod_name explicit
+ else findPackageModule hsc_env mod_name explicit;
case maybe_found of
Found loc pkg -> return (Succeeded (path, pkg))
projects / ghc-hetmet.git / blobdiff