2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section{Dealing with interface files}
8 loadHomeInterface, loadInterface, loadDecls,
9 loadSrcInterface, loadOrphanModules,
10 findAndReadIface, readIface, -- Used when reading the module's old interface
11 ifaceStats, discardDeclPrags,
12 initExternalPackageState
15 #include "HsVersions.h"
17 import {-# SOURCE #-} TcIface( tcIfaceDecl, tcIfaceRule, tcIfaceInst )
19 import Packages ( PackageState(..), PackageIdH(..), isHomePackage )
20 import DynFlags ( DynFlags(..), DynFlag( Opt_IgnoreInterfacePragmas ),
22 import IfaceSyn ( IfaceDecl(..), IfaceConDecl(..), IfaceClassOp(..),
23 IfaceConDecls(..), IfaceExpr(..), IfaceIdInfo(..),
24 IfaceType(..), IfaceExtName )
25 import IfaceEnv ( newGlobalBinder )
26 import HscTypes ( ModIface(..), TyThing, emptyModIface, EpsStats(..),
27 addEpsInStats, ExternalPackageState(..),
28 PackageTypeEnv, emptyTypeEnv, HscEnv(..),
29 lookupIfaceByModule, emptyPackageIfaceTable,
30 IsBootInterface, mkIfaceFixCache,
34 import BasicTypes ( Version, Fixity(..), FixityDirection(..),
38 import PrelNames ( gHC_PRIM )
39 import PrelInfo ( ghcPrimExports )
40 import PrelRules ( builtinRules )
41 import Rules ( extendRuleBaseList, mkRuleBase )
42 import InstEnv ( emptyInstEnv, extendInstEnvList )
43 import Name ( Name {-instance NamedThing-}, getOccName,
44 nameModule, isInternalName )
47 import Module ( Module, ModLocation(ml_hi_file), emptyModuleEnv,
49 extendModuleEnv, lookupModuleEnv, moduleUserString
51 import OccName ( OccName, mkOccEnv, lookupOccEnv, mkClassTyConOcc, mkClassDataConOcc,
52 mkSuperDictSelOcc, mkDataConWrapperOcc, mkDataConWorkerOcc )
53 import SrcLoc ( importedSrcLoc )
54 import Maybes ( MaybeErr(..) )
55 import FastString ( mkFastString )
56 import ErrUtils ( Message )
57 import Finder ( findModule, findPackageModule, FindResult(..), cantFindError )
59 import BinIface ( readBinIface )
60 import Panic ( ghcError, tryMost, showException, GhcException(..) )
65 %************************************************************************
67 loadSrcInterface, loadOrphanModules, loadHomeInterface
69 These three are called from TcM-land
71 %************************************************************************
74 loadSrcInterface :: SDoc -> Module -> IsBootInterface -> RnM ModIface
75 -- This is called for each 'import' declaration in the source code
76 -- On a failure, fail in the monad with an error message
78 loadSrcInterface doc mod want_boot
79 = do { mb_iface <- initIfaceTcRn $
80 loadInterface doc mod (ImportByUser want_boot)
82 Failed err -> failWithTc (elaborate err)
83 Succeeded iface -> return iface
86 elaborate err = hang (ptext SLIT("Failed to load interface for") <+>
87 quotes (ppr mod) <> colon) 4 err
90 loadOrphanModules :: [Module] -> TcM ()
91 loadOrphanModules mods
92 | null mods = returnM ()
93 | otherwise = initIfaceTcRn $
94 do { traceIf (text "Loading orphan modules:" <+>
99 load mod = loadSysInterface (mk_doc mod) mod
100 mk_doc mod = ppr mod <+> ptext SLIT("is a orphan-instance module")
103 loadHomeInterface :: SDoc -> Name -> TcRn ModIface
104 loadHomeInterface doc name
105 = ASSERT2( not (isInternalName name), ppr name <+> parens doc )
106 initIfaceTcRn $ loadSysInterface doc (nameModule name)
109 loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
110 -- A wrapper for loadInterface that Throws an exception if it fails
111 loadSysInterface doc mod_name
112 = do { mb_iface <- loadInterface doc mod_name ImportBySystem
114 Failed err -> ghcError (ProgramError (showSDoc err))
115 Succeeded iface -> return iface }
119 %*********************************************************
123 The main function to load an interface
124 for an imported module, and put it in
125 the External Package State
127 %*********************************************************
130 loadInterface :: SDoc -> Module -> WhereFrom
131 -> IfM lcl (MaybeErr Message ModIface)
133 -- If it can't find a suitable interface file, we
134 -- a) modify the PackageIfaceTable to have an empty entry
135 -- (to avoid repeated complaints)
136 -- b) return (Left message)
138 -- It's not necessarily an error for there not to be an interface
139 -- file -- perhaps the module has changed, and that interface
142 loadInterface doc_str mod from
143 = do { -- Read the state
144 (eps,hpt) <- getEpsAndHpt
146 ; traceIf (text "Considering whether to load" <+> ppr mod <+> ppr from)
148 -- Check whether we have the interface already
149 ; case lookupIfaceByModule hpt (eps_PIT eps) mod of {
151 -> returnM (Succeeded iface) ; -- Already loaded
152 -- The (src_imp == mi_boot iface) test checks that the already-loaded
153 -- interface isn't a boot iface. This can conceivably happen,
154 -- if an earlier import had a before we got to real imports. I think.
157 { let { hi_boot_file = case from of
158 ImportByUser usr_boot -> usr_boot
159 ImportBySystem -> sys_boot
161 ; mb_dep = lookupModuleEnv (eps_is_boot eps) mod
162 ; sys_boot = case mb_dep of
163 Just (_, is_boot) -> is_boot
165 -- The boot-ness of the requested interface,
166 } -- based on the dependencies in directly-imported modules
168 -- READ THE MODULE IN
169 ; let explicit | ImportByUser _ <- from = True
171 ; read_result <- findAndReadIface explicit doc_str mod hi_boot_file
173 ; case read_result of {
175 { let fake_iface = emptyModIface HomePackage mod
177 ; updateEps_ $ \eps ->
178 eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface }
179 -- Not found, so add an empty iface to
180 -- the EPS map so that we don't look again
182 ; returnM (Failed err) } ;
185 Succeeded (iface, file_path) -- Sanity check:
186 | ImportBySystem <- from, -- system-importing...
187 isHomePackage (mi_package iface), -- ...a home-package module
188 Nothing <- mb_dep -- ...that we know nothing about
189 -> returnM (Failed (badDepMsg mod))
194 loc_doc = text file_path <+> colon
196 initIfaceLcl mod loc_doc $ do
198 -- Load the new ModIface into the External Package State
199 -- Even home-package interfaces loaded by loadInterface
200 -- (which only happens in OneShot mode; in Batch/Interactive
201 -- mode, home-package modules are loaded one by one into the HPT)
202 -- are put in the EPS.
204 -- The main thing is to add the ModIface to the PIT, but
206 -- IfaceDecls, IfaceInst, IfaceRules
207 -- out of the ModIface and put them into the big EPS pools
209 -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
210 --- names is done correctly (notably, whether this is an .hi file or .hi-boot file).
211 -- If we do loadExport first the wrong info gets into the cache (unless we
212 -- explicitly tag each export which seems a bit of a bore)
214 ; ignore_prags <- doptM Opt_IgnoreInterfacePragmas
215 ; new_eps_decls <- loadDecls ignore_prags (mi_decls iface)
216 ; new_eps_insts <- mapM tcIfaceInst (mi_insts iface)
217 ; new_eps_rules <- if ignore_prags
219 else mapM tcIfaceRule (mi_rules iface)
221 ; let { final_iface = iface { mi_decls = panic "No mi_decls in PIT",
222 mi_insts = panic "No mi_insts in PIT",
223 mi_rules = panic "No mi_rules in PIT" } }
225 ; updateEps_ $ \ eps ->
226 eps { eps_PIT = extendModuleEnv (eps_PIT eps) mod final_iface,
227 eps_PTE = addDeclsToPTE (eps_PTE eps) new_eps_decls,
228 eps_rule_base = extendRuleBaseList (eps_rule_base eps) new_eps_rules,
229 eps_inst_env = extendInstEnvList (eps_inst_env eps) new_eps_insts,
230 eps_stats = addEpsInStats (eps_stats eps) (length new_eps_decls)
231 (length new_eps_insts) (length new_eps_rules) }
233 ; return (Succeeded final_iface)
237 = hang (ptext SLIT("Interface file inconsistency:"))
238 2 (sep [ptext SLIT("home-package module") <+> quotes (ppr mod) <+> ptext SLIT("is mentioned,"),
239 ptext SLIT("but does not appear in the dependencies of the interface")])
241 -----------------------------------------------------
242 -- Loading type/class/value decls
243 -- We pass the full Module name here, replete with
244 -- its package info, so that we can build a Name for
245 -- each binder with the right package info in it
246 -- All subsequent lookups, including crucially lookups during typechecking
247 -- the declaration itself, will find the fully-glorious Name
248 -----------------------------------------------------
250 addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
251 addDeclsToPTE pte things = extendNameEnvList pte things
254 -> [(Version, IfaceDecl)]
255 -> IfL [(Name,TyThing)]
256 loadDecls ignore_prags ver_decls
257 = do { mod <- getIfModule
258 ; thingss <- mapM (loadDecl ignore_prags mod) ver_decls
259 ; return (concat thingss)
262 loadDecl :: Bool -- Don't load pragmas into the decl pool
264 -> (Version, IfaceDecl)
265 -> IfL [(Name,TyThing)] -- The list can be poked eagerly, but the
266 -- TyThings are forkM'd thunks
267 loadDecl ignore_prags mod (_version, decl)
268 = do { -- Populate the name cache with final versions of all
269 -- the names associated with the decl
270 main_name <- mk_new_bndr mod Nothing (ifName decl)
271 ; implicit_names <- mapM (mk_new_bndr mod (Just main_name)) (ifaceDeclSubBndrs decl)
273 -- Typecheck the thing, lazily
274 -- NB. firstly, the laziness is there in case we never need the
275 -- declaration (in one-shot mode), and secondly it is there so that
276 -- we don't look up the occurrence of a name before calling mk_new_bndr
277 -- on the binder. This is important because we must get the right name
278 -- which includes its nameParent.
279 ; thing <- forkM doc (bumpDeclStats main_name >> tcIfaceDecl stripped_decl)
280 ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
281 lookup n = case lookupOccEnv mini_env (getOccName n) of
283 Nothing -> pprPanic "loadDecl" (ppr main_name <+> ppr n)
285 ; returnM ((main_name, thing) : [(n, lookup n) | n <- implicit_names]) }
286 -- We build a list from the *known* names, with (lookup n) thunks
287 -- as the TyThings. That way we can extend the PTE without poking the
290 stripped_decl | ignore_prags = discardDeclPrags decl
293 -- mk_new_bndr allocates in the name cache the final canonical
294 -- name for the thing, with the correct
297 -- imported name, to fix the module correctly in the cache
298 mk_new_bndr mod mb_parent occ
299 = newGlobalBinder mod occ mb_parent
300 (importedSrcLoc (moduleUserString mod))
302 doc = ptext SLIT("Declaration for") <+> ppr (ifName decl)
304 discardDeclPrags :: IfaceDecl -> IfaceDecl
305 discardDeclPrags decl@(IfaceId {ifIdInfo = HasInfo _}) = decl { ifIdInfo = NoInfo }
306 discardDeclPrags decl = decl
308 bumpDeclStats :: Name -> IfL () -- Record that one more declaration has actually been used
310 = do { traceIf (text "Loading decl for" <+> ppr name)
311 ; updateEps_ (\eps -> let stats = eps_stats eps
312 in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })
316 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
317 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
318 -- Deeply revolting, because it has to predict what gets bound,
319 -- especially the question of whether there's a wrapper for a datacon
321 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ, ifSigs = sigs })
322 = [tc_occ, dc_occ, dcww_occ] ++
323 [op | IfaceClassOp op _ _ <- sigs] ++
324 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]]
326 n_ctxt = length sc_ctxt
328 tc_occ = mkClassTyConOcc cls_occ
329 dc_occ = mkClassDataConOcc cls_occ
330 dcww_occ | is_newtype = mkDataConWrapperOcc dc_occ -- Newtypes have wrapper but no worker
331 | otherwise = mkDataConWorkerOcc dc_occ -- Otherwise worker but no wrapper
332 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
334 ifaceDeclSubBndrs (IfaceData {ifCons = IfAbstractTyCon})
337 ifaceDeclSubBndrs (IfaceData {ifCons = IfNewTyCon (IfVanillaCon { ifConOcc = con_occ,
338 ifConFields = fields})})
339 = fields ++ [con_occ, mkDataConWrapperOcc con_occ]
340 -- Wrapper, no worker; see MkId.mkDataConIds
342 ifaceDeclSubBndrs (IfaceData {ifCons = IfDataTyCon cons})
343 = nub (concatMap fld_occs cons) -- Eliminate duplicate fields
344 ++ concatMap dc_occs cons
346 fld_occs (IfVanillaCon { ifConFields = fields }) = fields
347 fld_occs (IfGadtCon {}) = []
349 | has_wrapper = [con_occ, work_occ, wrap_occ]
350 | otherwise = [con_occ, work_occ]
352 con_occ = ifConOcc con_decl
353 strs = ifConStricts con_decl
354 wrap_occ = mkDataConWrapperOcc con_occ
355 work_occ = mkDataConWorkerOcc con_occ
356 has_wrapper = any isMarkedStrict strs -- See MkId.mkDataConIds (sigh)
357 -- ToDo: may miss strictness in existential dicts
359 ifaceDeclSubBndrs _other = []
364 %*********************************************************
366 \subsection{Reading an interface file}
368 %*********************************************************
371 findAndReadIface :: Bool -- True <=> explicit user import
373 -> IsBootInterface -- True <=> Look for a .hi-boot file
374 -- False <=> Look for .hi file
375 -> TcRnIf gbl lcl (MaybeErr Message (ModIface, FilePath))
376 -- Nothing <=> file not found, or unreadable, or illegible
377 -- Just x <=> successfully found and parsed
379 -- It *doesn't* add an error to the monad, because
380 -- sometimes it's ok to fail... see notes with loadInterface
382 findAndReadIface explicit doc_str mod_name hi_boot_file
383 = do { traceIf (sep [hsep [ptext SLIT("Reading"),
385 then ptext SLIT("[boot]")
387 ptext SLIT("interface for"),
388 ppr mod_name <> semi],
389 nest 4 (ptext SLIT("reason:") <+> doc_str)])
391 -- Check for GHC.Prim, and return its static interface
393 ; let base_pkg = basePackageId (pkgState dflags)
394 ; if mod_name == gHC_PRIM
395 then returnM (Succeeded (ghcPrimIface{ mi_package = base_pkg },
396 "<built in interface for GHC.Prim>"))
400 ; hsc_env <- getTopEnv
401 ; mb_found <- ioToIOEnv (findHiFile hsc_env explicit mod_name hi_boot_file)
404 { traceIf (ptext SLIT("...not found"))
406 ; returnM (Failed (cantFindError dflags mod_name err)) } ;
408 Succeeded (file_path, pkg) -> do
410 -- Found file, so read it
411 { traceIf (ptext SLIT("readIFace") <+> text file_path)
412 ; read_result <- readIface mod_name file_path hi_boot_file
413 ; case read_result of
414 Failed err -> returnM (Failed (badIfaceFile file_path err))
416 | mi_module iface /= mod_name ->
417 return (Failed (wrongIfaceModErr iface mod_name file_path))
419 returnM (Succeeded (iface{mi_package=pkg}, file_path))
420 -- Don't forget to fill in the package name...
423 findHiFile :: HscEnv -> Bool -> Module -> IsBootInterface
424 -> IO (MaybeErr FindResult (FilePath, PackageIdH))
425 findHiFile hsc_env explicit mod_name hi_boot_file
427 -- In interactive or --make mode, we are *not allowed* to demand-load
428 -- a home package .hi file. So don't even look for them.
429 -- This helps in the case where you are sitting in eg. ghc/lib/std
430 -- and start up GHCi - it won't complain that all the modules it tries
431 -- to load are found in the home location.
432 let { home_allowed = isOneShot (ghcMode (hsc_dflags hsc_env)) } ;
433 maybe_found <- if home_allowed
434 then findModule hsc_env mod_name explicit
435 else findPackageModule hsc_env mod_name explicit;
438 Found loc pkg -> return (Succeeded (path, pkg))
440 path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc)
442 err -> return (Failed err)
446 @readIface@ tries just the one file.
449 readIface :: Module -> String -> IsBootInterface
450 -> TcRnIf gbl lcl (MaybeErr Message ModIface)
451 -- Failed err <=> file not found, or unreadable, or illegible
452 -- Succeeded iface <=> successfully found and parsed
454 readIface wanted_mod file_path is_hi_boot_file
455 = do { dflags <- getDOpts
457 { res <- tryMost (readBinIface file_path)
460 | wanted_mod == actual_mod -> return (Succeeded iface)
461 | otherwise -> return (Failed err)
463 actual_mod = mi_module iface
464 err = hiModuleNameMismatchWarn wanted_mod actual_mod
466 Left exn -> return (Failed (text (showException exn)))
471 %*********************************************************
473 Wired-in interface for GHC.Prim
475 %*********************************************************
478 initExternalPackageState :: ExternalPackageState
479 initExternalPackageState
481 eps_is_boot = emptyModuleEnv,
482 eps_PIT = emptyPackageIfaceTable,
483 eps_PTE = emptyTypeEnv,
484 eps_inst_env = emptyInstEnv,
485 eps_rule_base = mkRuleBase builtinRules,
486 -- Initialise the EPS rule pool with the built-in rules
487 eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
488 , n_insts_in = 0, n_insts_out = 0
489 , n_rules_in = length builtinRules, n_rules_out = 0 }
494 %*********************************************************
496 Wired-in interface for GHC.Prim
498 %*********************************************************
501 ghcPrimIface :: ModIface
503 = (emptyModIface HomePackage gHC_PRIM) {
504 mi_exports = [(gHC_PRIM, ghcPrimExports)],
506 mi_fixities = fixities,
507 mi_fix_fn = mkIfaceFixCache fixities
510 fixities = [(getOccName seqId, Fixity 0 InfixR)]
514 %*********************************************************
516 \subsection{Statistics}
518 %*********************************************************
521 ifaceStats :: ExternalPackageState -> SDoc
523 = hcat [text "Renamer stats: ", msg]
525 stats = eps_stats eps
527 [int (n_ifaces_in stats) <+> text "interfaces read",
528 hsep [ int (n_decls_out stats), text "type/class/variable imported, out of",
529 int (n_decls_in stats), text "read"],
530 hsep [ int (n_insts_out stats), text "instance decls imported, out of",
531 int (n_insts_in stats), text "read"],
532 hsep [ int (n_rules_out stats), text "rule decls imported, out of",
533 int (n_rules_in stats), text "read"]
538 %*********************************************************
542 %*********************************************************
545 badIfaceFile file err
546 = vcat [ptext SLIT("Bad interface file:") <+> text file,
549 hiModuleNameMismatchWarn :: Module -> Module -> Message
550 hiModuleNameMismatchWarn requested_mod read_mod =
551 hsep [ ptext SLIT("Something is amiss; requested module name")
553 , ptext SLIT("differs from name found in the interface file")
557 wrongIfaceModErr iface mod_name file_path
558 = sep [ptext SLIT("Interface file") <+> iface_file,
559 ptext SLIT("contains module") <+> quotes (ppr (mi_module iface)) <> comma,
560 ptext SLIT("but we were expecting module") <+> quotes (ppr mod_name),
561 sep [ptext SLIT("Probable cause: the source code which generated"),
563 ptext SLIT("has an incompatible module name")
566 where iface_file = doubleQuotes (text file_path)