import FamInstEnv
import Name
import NameEnv
+import NameSet
import MkId
import Module
import OccName
import BinIface
import Panic
+import Control.Monad (when)
import Data.List
import Data.Maybe
import Data.IORef
-- The (src_imp == mi_boot iface) test checks that the already-loaded
-- interface isn't a boot iface. This can conceivably happen,
-- if an earlier import had a before we got to real imports. I think.
- other -> do
+ other -> do {
- { let { hi_boot_file = case from of
+ let { hi_boot_file = case from of
ImportByUser usr_boot -> usr_boot
ImportBySystem -> sys_boot
--
-- The main thing is to add the ModIface to the PIT, but
-- we also take the
- -- IfaceDecls, IfaceInst, IfaceRules
+ -- IfaceDecls, IfaceInst, IfaceFamInst, IfaceRules, IfaceVectInfo
-- out of the ModIface and put them into the big EPS pools
-- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
mi_insts = panic "No mi_insts in PIT",
mi_fam_insts = panic "No mi_fam_insts in PIT",
mi_rules = panic "No mi_rules in PIT"
- } }
+ }
+ ; new_eps_vect_info =
+ VectInfo {
+ vectInfoCCVar = mkNameSet
+ (ifaceVectInfoCCVar . mi_vect_info $ iface)
+ }
+ }
; updateEps_ $ \ eps ->
eps {
new_eps_insts,
eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps)
new_eps_fam_insts,
+ eps_vect_info = plusVectInfo (eps_vect_info eps)
+ new_eps_vect_info,
eps_mod_fam_inst_env
= let
fam_inst_env =
= do { -- Populate the name cache with final versions of all
-- the names associated with the decl
main_name <- mk_new_bndr mod (ifName decl)
- ; traceIf (text "Loading decl for " <> ppr main_name)
+-- ; traceIf (text "Loading decl for " <> ppr main_name)
; implicit_names <- mapM (mk_new_bndr mod) (ifaceDeclSubBndrs decl)
-- Typecheck the thing, lazily
; thing <- forkM doc $ do { bumpDeclStats main_name
; tcIfaceDecl ignore_prags decl }
- -- Populate the type environment with the implicitTyThings too
+ -- Populate the type environment with the implicitTyThings too.
+ --
+ -- Note [Tricky iface loop]
+ -- ~~~~~~~~~~~~~~~~~~~~~~~~
+ -- The delicate point here is that 'mini-env' should be
+ -- buildable from 'thing' without demanding any of the things 'forkM'd
+ -- by tcIfaceDecl. For example
+ -- class C a where { data T a; op :: T a -> Int }
+ -- We return the bindings
+ -- [("C", <cls>), ("T", lookup env "T"), ("op", lookup env "op")]
+ -- The call (lookup env "T") must return the tycon T without first demanding
+ -- op; because getting the latter will look up T, hence loop.
+ --
+ -- Of course, there is no reason in principle why (lookup env "T") should demand
+ -- anything do to with op, but take care:
+ -- (a) implicitTyThings, and
+ -- (b) getOccName of all the things returned by implicitThings,
+ -- must not depend on any of the nested type-checks
+ --
+ -- All a bit too finely-balanced for my liking.
+
; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
lookup n = case lookupOccEnv mini_env (getOccName n) of
Just thing -> thing
-- Look for the file
; hsc_env <- getTopEnv
- ; mb_found <- ioToIOEnv (findHiFile hsc_env mod hi_boot_file)
+ ; mb_found <- ioToIOEnv (findExactModule hsc_env mod)
; case mb_found of {
- Failed err -> do
+
+ err | notFound err -> do
{ traceIf (ptext SLIT("...not found"))
; dflags <- getDOpts
; returnM (Failed (cannotFindInterface dflags
(moduleName mod) err)) } ;
-
- Succeeded file_path -> do
+ Found loc mod -> do
-- Found file, so read it
- { traceIf (ptext SLIT("readIFace") <+> text file_path)
+ { let { file_path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc) }
+
+ ; if thisPackage dflags == modulePackageId mod
+ && not (isOneShot (ghcMode dflags))
+ then returnM (Failed (homeModError mod loc))
+ else do {
+
+ ; traceIf (ptext SLIT("readIFace") <+> text file_path)
; read_result <- readIface mod file_path hi_boot_file
; case read_result of
Failed err -> returnM (Failed (badIfaceFile file_path err))
| otherwise ->
returnM (Succeeded (iface, file_path))
-- Don't forget to fill in the package name...
- }}}
-
-findHiFile :: HscEnv -> Module -> IsBootInterface
- -> IO (MaybeErr FindResult FilePath)
-findHiFile hsc_env mod hi_boot_file
- = do
- maybe_found <- findExactModule hsc_env mod
- case maybe_found of
- Found loc mod -> return (Succeeded path)
- where
- path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc)
- err -> return (Failed err)
+ }}}}
+
+notFound (Found _ _) = False
+notFound _ = True
\end{code}
@readIface@ tries just the one file.
-- Initialise the EPS rule pool with the built-in rules
eps_mod_fam_inst_env
= emptyModuleEnv,
+ eps_vect_info = noVectInfo,
eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
, n_insts_in = 0, n_insts_out = 0
, n_rules_in = length builtinRules, n_rules_out = 0 }
<+> ppr (mi_mod_vers iface) <+> pp_sub_vers
<+> (if mi_orphan iface then ptext SLIT("[orphan module]") else empty)
<+> (if mi_finsts iface then ptext SLIT("[family instance module]") else empty)
- <+> int opt_HiVersion
+ <+> integer opt_HiVersion
<+> ptext SLIT("where")
, vcat (map pprExport (mi_exports iface))
, pprDeps (mi_deps iface)
]
]
where iface_file = doubleQuotes (text file_path)
+
+homeModError mod location
+ = ptext SLIT("attempting to use module ") <> quotes (ppr mod)
+ <> (case ml_hs_file location of
+ Just file -> space <> parens (text file)
+ Nothing -> empty)
+ <+> ptext SLIT("which is not loaded")
\end{code}
projects / ghc-hetmet.git / blobdiff