2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section{Dealing with interface files}
8 loadHomeInterface, loadInterface,
9 loadSrcInterface, loadOrphanModules, loadHiBootInterface,
10 readIface, -- Used when reading the module's old interface
11 predInstGates, ifaceInstGates, ifaceStats, discardDeclPrags,
12 initExternalPackageState,
13 noIfaceErr, -- used by CompManager too
16 #include "HsVersions.h"
18 import {-# SOURCE #-} TcIface( tcIfaceDecl )
20 import Packages ( PackageState(..), PackageIdH(..), isHomePackage )
21 import DriverState ( v_GhcMode, isCompManagerMode )
22 import DriverUtil ( replaceFilenameSuffix )
23 import CmdLineOpts ( DynFlags(..), DynFlag( Opt_IgnoreInterfacePragmas ) )
24 import Parser ( parseIface )
26 import IfaceSyn ( IfaceDecl(..), IfaceConDecl(..), IfaceClassOp(..),
27 IfaceConDecls(..), IfaceInst(..), IfaceRule(..),
28 IfaceExpr(..), IfaceTyCon(..), IfaceIdInfo(..),
29 IfaceType(..), IfacePredType(..), IfaceExtName,
31 import IfaceEnv ( newGlobalBinder, lookupIfaceExt, lookupIfaceTc,
33 import HscTypes ( ModIface(..), TyThing, emptyModIface, EpsStats(..),
34 addEpsInStats, ExternalPackageState(..),
35 PackageTypeEnv, emptyTypeEnv,
36 lookupIfaceByModule, emptyPackageIfaceTable,
37 IsBootInterface, mkIfaceFixCache, Gated,
38 implicitTyThings, addRulesToPool, addInstsToPool,
42 import BasicTypes ( Version, Fixity(..), FixityDirection(..),
44 import TcType ( Type, tcSplitTyConApp_maybe )
45 import Type ( funTyCon )
48 import PrelNames ( gHC_PRIM )
49 import PrelInfo ( ghcPrimExports )
50 import PrelRules ( builtinRules )
51 import Rules ( emptyRuleBase )
52 import InstEnv ( emptyInstEnv )
53 import Name ( Name {-instance NamedThing-}, getOccName,
54 nameModule, isInternalName )
57 import Module ( Module, ModLocation(ml_hi_file), emptyModuleEnv,
58 extendModuleEnv, lookupModuleEnv, moduleUserString
60 import OccName ( OccName, mkOccEnv, lookupOccEnv, mkClassTyConOcc, mkClassDataConOcc,
61 mkSuperDictSelOcc, mkDataConWrapperOcc, mkDataConWorkerOcc )
62 import Class ( Class, className )
63 import TyCon ( tyConName )
64 import SrcLoc ( mkSrcLoc, importedSrcLoc )
65 import Maybes ( mapCatMaybes, MaybeErr(..) )
66 import StringBuffer ( hGetStringBuffer )
67 import FastString ( mkFastString )
68 import ErrUtils ( Message, mkLocMessage )
69 import Finder ( findModule, findPackageModule, FindResult(..),
73 import BinIface ( readBinIface )
74 import Panic ( ghcError, tryMost, showException, GhcException(..) )
77 import DATA_IOREF ( readIORef )
83 %************************************************************************
85 loadSrcInterface, loadOrphanModules
87 These two are called from TcM-land
89 %************************************************************************
92 loadSrcInterface :: SDoc -> Module -> IsBootInterface -> RnM ModIface
93 -- This is called for each 'import' declaration in the source code
94 -- On a failure, fail in the monad with an error message
96 loadSrcInterface doc mod_name want_boot
97 = do { mb_iface <- initIfaceTcRn $ loadInterface doc mod_name
98 (ImportByUser want_boot)
100 Failed err -> failWithTc (elaborate err)
101 Succeeded iface -> return iface
104 elaborate err = hang (ptext SLIT("Failed to load interface for") <+>
105 quotes (ppr mod_name) <> colon) 4 err
107 loadHiBootInterface :: TcRn [Name]
108 -- Load the hi-boot iface for the module being compiled,
109 -- if it indeed exists in the transitive closure of imports
110 -- Return the list of names exported by the hi-boot file
115 ; traceIf (text "loadHiBootInterface" <+> ppr mod)
117 -- We're read all the direct imports by now, so eps_is_boot will
118 -- record if any of our imports mention us by way of hi-boot file
119 ; case lookupModuleEnv (eps_is_boot eps) mod of {
120 Nothing -> return [] ; -- The typical case
122 Just (_, False) -> -- Someone below us imported us!
123 -- This is a loop with no hi-boot in the way
124 failWithTc (moduleLoop mod) ;
126 Just (mod_nm, True) -> -- There's a hi-boot interface below us
129 do { -- Load it (into the PTE), and return the exported names
130 iface <- loadSrcInterface (mk_doc mod_nm) mod_nm True
131 ; sequenceM [ lookupOrig mod_nm occ
132 | (mod,avails) <- mi_exports iface,
133 avail <- avails, occ <- availNames avail]
136 mk_doc mod = ptext SLIT("Need the hi-boot interface for") <+> ppr mod
137 <+> ptext SLIT("to compare against the Real Thing")
139 moduleLoop mod = ptext SLIT("Circular imports: module") <+> quotes (ppr mod)
140 <+> ptext SLIT("depends on itself")
142 loadOrphanModules :: [Module] -> TcM ()
143 loadOrphanModules mods
144 | null mods = returnM ()
145 | otherwise = initIfaceTcRn $
146 do { traceIf (text "Loading orphan modules:" <+>
151 load mod = loadSysInterface (mk_doc mod) mod
152 mk_doc mod = ppr mod <+> ptext SLIT("is a orphan-instance module")
155 %*********************************************************
158 Called from Iface-land
160 %*********************************************************
163 loadHomeInterface :: SDoc -> Name -> IfM lcl ModIface
164 loadHomeInterface doc name
165 = ASSERT2( not (isInternalName name), ppr name <+> parens doc )
166 loadSysInterface doc (nameModule name)
168 loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
169 -- A wrapper for loadInterface that Throws an exception if it fails
170 loadSysInterface doc mod_name
171 = do { mb_iface <- loadInterface doc mod_name ImportBySystem
173 Failed err -> ghcError (ProgramError (showSDoc err))
174 Succeeded iface -> return iface }
178 %*********************************************************
182 The main function to load an interface
183 for an imported module, and put it in
184 the External Package State
186 %*********************************************************
189 loadInterface :: SDoc -> Module -> WhereFrom
190 -> IfM lcl (MaybeErr Message ModIface)
191 -- If it can't find a suitable interface file, we
192 -- a) modify the PackageIfaceTable to have an empty entry
193 -- (to avoid repeated complaints)
194 -- b) return (Left message)
196 -- It's not necessarily an error for there not to be an interface
197 -- file -- perhaps the module has changed, and that interface
200 loadInterface doc_str mod from
201 = do { -- Read the state
202 (eps,hpt) <- getEpsAndHpt
204 ; traceIf (text "Considering whether to load" <+> ppr mod <+> ppr from)
206 -- Check whether we have the interface already
207 ; case lookupIfaceByModule hpt (eps_PIT eps) mod of {
209 -> returnM (Succeeded iface) ; -- Already loaded
210 -- The (src_imp == mi_boot iface) test checks that the already-loaded
211 -- interface isn't a boot iface. This can conceivably happen,
212 -- if an earlier import had a before we got to real imports. I think.
215 { let { hi_boot_file = case from of
216 ImportByUser usr_boot -> usr_boot
217 ImportBySystem -> sys_boot
219 ; mb_dep = lookupModuleEnv (eps_is_boot eps) mod
220 ; sys_boot = case mb_dep of
221 Just (_, is_boot) -> is_boot
223 -- The boot-ness of the requested interface,
224 } -- based on the dependencies in directly-imported modules
226 -- READ THE MODULE IN
227 ; let explicit | ImportByUser _ <- from = True
229 ; read_result <- findAndReadIface explicit doc_str mod hi_boot_file
231 ; case read_result of {
233 { let fake_iface = emptyModIface HomePackage mod
235 ; updateEps_ $ \eps ->
236 eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface }
237 -- Not found, so add an empty iface to
238 -- the EPS map so that we don't look again
240 ; returnM (Failed err) } ;
243 Succeeded (iface, file_path) -- Sanity check:
244 | ImportBySystem <- from, -- system-importing...
245 isHomePackage (mi_package iface), -- ...a home-package module
246 Nothing <- mb_dep -- ...that we know nothing about
247 -> returnM (Failed (badDepMsg mod))
252 loc_doc = text file_path <+> colon
254 initIfaceLcl mod loc_doc $ do
256 -- Load the new ModIface into the External Package State
257 -- Even home-package interfaces loaded by loadInterface
258 -- (which only happens in OneShot mode; in Batch/Interactive
259 -- mode, home-package modules are loaded one by one into the HPT)
260 -- are put in the EPS.
262 -- The main thing is to add the ModIface to the PIT, but
264 -- IfaceDecls, IfaceInst, IfaceRules
265 -- out of the ModIface and put them into the big EPS pools
267 -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
268 --- names is done correctly (notably, whether this is an .hi file or .hi-boot file).
269 -- If we do loadExport first the wrong info gets into the cache (unless we
270 -- explicitly tag each export which seems a bit of a bore)
272 ; ignore_prags <- doptM Opt_IgnoreInterfacePragmas
273 ; new_eps_decls <- mapM (loadDecl ignore_prags) (mi_decls iface)
274 ; new_eps_insts <- mapM loadInst (mi_insts iface)
275 ; new_eps_rules <- if ignore_prags
277 else mapM loadRule (mi_rules iface)
279 ; let { final_iface = iface { mi_decls = panic "No mi_decls in PIT",
280 mi_insts = panic "No mi_insts in PIT",
281 mi_rules = panic "No mi_rules in PIT" } }
283 ; updateEps_ $ \ eps ->
284 eps { eps_PIT = extendModuleEnv (eps_PIT eps) mod final_iface,
285 eps_PTE = addDeclsToPTE (eps_PTE eps) new_eps_decls,
286 eps_rules = addRulesToPool (eps_rules eps) new_eps_rules,
287 eps_insts = addInstsToPool (eps_insts eps) new_eps_insts,
288 eps_stats = addEpsInStats (eps_stats eps) (length new_eps_decls)
289 (length new_eps_insts) (length new_eps_rules) }
291 ; return (Succeeded final_iface)
295 = hang (ptext SLIT("Interface file inconsistency:"))
296 2 (sep [ptext SLIT("home-package module") <+> quotes (ppr mod) <+> ptext SLIT("is mentioned,"),
297 ptext SLIT("but does not appear in the dependencies of the interface")])
299 -----------------------------------------------------
300 -- Loading type/class/value decls
301 -- We pass the full Module name here, replete with
302 -- its package info, so that we can build a Name for
303 -- each binder with the right package info in it
304 -- All subsequent lookups, including crucially lookups during typechecking
305 -- the declaration itself, will find the fully-glorious Name
306 -----------------------------------------------------
308 addDeclsToPTE :: PackageTypeEnv -> [[(Name,TyThing)]] -> PackageTypeEnv
309 addDeclsToPTE pte things = foldl extendNameEnvList pte things
311 loadDecl :: Bool -- Don't load pragmas into the decl pool
312 -> (Version, IfaceDecl)
313 -> IfL [(Name,TyThing)] -- The list can be poked eagerly, but the
314 -- TyThings are forkM'd thunks
315 loadDecl ignore_prags (_version, decl)
316 = do { -- Populate the name cache with final versions of all
317 -- the names associated with the decl
319 ; main_name <- mk_new_bndr mod Nothing (ifName decl)
320 ; implicit_names <- mapM (mk_new_bndr mod (Just main_name)) (ifaceDeclSubBndrs decl)
322 -- Typecheck the thing, lazily
323 ; thing <- forkM doc (bumpDeclStats main_name >> tcIfaceDecl stripped_decl)
324 ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
325 lookup n = case lookupOccEnv mini_env (getOccName n) of
327 Nothing -> pprPanic "loadDecl" (ppr main_name <+> ppr n)
329 ; returnM ((main_name, thing) : [(n, lookup n) | n <- implicit_names]) }
330 -- We build a list from the *known* names, with (lookup n) thunks
331 -- as the TyThings. That way we can extend the PTE without poking the
334 stripped_decl | ignore_prags = discardDeclPrags decl
337 -- mk_new_bndr allocates in the name cache the final canonical
338 -- name for the thing, with the correct
341 -- imported name, to fix the module correctly in the cache
342 mk_new_bndr mod mb_parent occ
343 = newGlobalBinder mod occ mb_parent
344 (importedSrcLoc (moduleUserString mod))
346 doc = ptext SLIT("Declaration for") <+> ppr (ifName decl)
348 discardDeclPrags :: IfaceDecl -> IfaceDecl
349 discardDeclPrags decl@(IfaceId {ifIdInfo = HasInfo _}) = decl { ifIdInfo = NoInfo }
350 discardDeclPrags decl = decl
352 bumpDeclStats :: Name -> IfL () -- Record that one more declaration has actually been used
354 = do { traceIf (text "Loading decl for" <+> ppr name)
355 ; updateEps_ (\eps -> let stats = eps_stats eps
356 in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })
360 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
361 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
362 -- Deeply revolting, because it has to predict what gets bound,
363 -- especially the question of whether there's a wrapper for a datacon
365 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ, ifSigs = sigs })
366 = [tc_occ, dc_occ, dcww_occ] ++
367 [op | IfaceClassOp op _ _ <- sigs] ++
368 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]]
370 n_ctxt = length sc_ctxt
372 tc_occ = mkClassTyConOcc cls_occ
373 dc_occ = mkClassDataConOcc cls_occ
374 dcww_occ | is_newtype = mkDataConWrapperOcc dc_occ -- Newtypes have wrapper but no worker
375 | otherwise = mkDataConWorkerOcc dc_occ -- Otherwise worker but no wrapper
376 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
378 ifaceDeclSubBndrs (IfaceData {ifCons = IfAbstractTyCon})
381 ifaceDeclSubBndrs (IfaceData {ifCons = IfNewTyCon (IfVanillaCon { ifConOcc = con_occ,
382 ifConFields = fields})})
383 = fields ++ [con_occ, mkDataConWrapperOcc con_occ]
384 -- Wrapper, no worker; see MkId.mkDataConIds
386 ifaceDeclSubBndrs (IfaceData {ifCons = IfDataTyCon _ cons})
387 = nub (concatMap fld_occs cons) -- Eliminate duplicate fields
388 ++ concatMap dc_occs cons
390 fld_occs (IfVanillaCon { ifConFields = fields }) = fields
391 fld_occs (IfGadtCon {}) = []
393 | has_wrapper = [con_occ, work_occ, wrap_occ]
394 | otherwise = [con_occ, work_occ]
396 con_occ = ifConOcc con_decl
397 strs = ifConStricts con_decl
398 wrap_occ = mkDataConWrapperOcc con_occ
399 work_occ = mkDataConWorkerOcc con_occ
400 has_wrapper = any isMarkedStrict strs -- See MkId.mkDataConIds (sigh)
401 -- ToDo: may miss strictness in existential dicts
403 ifaceDeclSubBndrs _other = []
405 -----------------------------------------------------
406 -- Loading instance decls
407 -----------------------------------------------------
409 loadInst :: IfaceInst -> IfL (Name, Gated IfaceInst)
411 loadInst decl@(IfaceInst {ifInstHead = inst_ty})
413 -- Find out what type constructors and classes are "gates" for the
414 -- instance declaration. If all these "gates" are slurped in then
415 -- we should slurp the instance decl too.
417 -- We *don't* want to count names in the context part as gates, though.
419 -- instance Foo a => Baz (T a) where ...
421 -- Here the gates are Baz and T, but *not* Foo.
423 -- HOWEVER: functional dependencies make things more complicated
424 -- class C a b | a->b where ...
425 -- instance C Foo Baz where ...
426 -- Here, the gates are really only C and Foo, *not* Baz.
427 -- That is, if C and Foo are visible, even if Baz isn't, we must
430 -- Rather than take fundeps into account "properly", we just slurp
431 -- if C is visible and *any one* of the Names in the types
432 -- This is a slightly brutal approximation, but most instance decls
433 -- are regular H98 ones and it's perfect for them.
435 -- NOTICE that we rename the type before extracting its free
436 -- variables. The free-variable finder for a renamed HsType
437 -- does the Right Thing for built-in syntax like [] and (,).
438 let { (cls_ext, tc_exts) = ifaceInstGates inst_ty }
439 ; cls <- lookupIfaceExt cls_ext
440 ; tcs <- mapM lookupIfaceTc tc_exts
441 ; (mod, doc) <- getIfCtxt
442 ; returnM (cls, (tcs, (mod, doc, decl)))
445 -----------------------------------------------------
447 -----------------------------------------------------
449 loadRule :: IfaceRule -> IfL (Gated IfaceRule)
450 -- "Gate" the rule simply by a crude notion of the free vars of
451 -- the LHS. It can be crude, because having too few free vars is safe.
452 loadRule decl@(IfaceRule {ifRuleHead = fn, ifRuleArgs = args})
453 = do { names <- mapM lookupIfaceExt (fn : arg_fvs)
454 ; (mod, doc) <- getIfCtxt
455 ; returnM (names, (mod, doc, decl)) }
457 arg_fvs = [n | arg <- args, n <- crudeIfExprGblFvs arg]
460 ---------------------------
461 crudeIfExprGblFvs :: IfaceExpr -> [IfaceExtName]
462 -- A crude approximation to the free external names of an IfExpr
463 -- Returns a subset of the true answer
464 crudeIfExprGblFvs (IfaceType ty) = get_tcs ty
465 crudeIfExprGblFvs (IfaceExt v) = [v]
466 crudeIfExprGblFvs other = [] -- Well, I said it was crude
468 get_tcs :: IfaceType -> [IfaceExtName]
469 -- Get a crude subset of the TyCons of an IfaceType
470 get_tcs (IfaceTyVar _) = []
471 get_tcs (IfaceAppTy t1 t2) = get_tcs t1 ++ get_tcs t2
472 get_tcs (IfaceFunTy t1 t2) = get_tcs t1 ++ get_tcs t2
473 get_tcs (IfaceForAllTy _ t) = get_tcs t
474 get_tcs (IfacePredTy st) = case st of
475 IfaceClassP cl ts -> get_tcs_s ts
476 IfaceIParam _ t -> get_tcs t
477 get_tcs (IfaceTyConApp (IfaceTc tc) ts) = tc : get_tcs_s ts
478 get_tcs (IfaceTyConApp other ts) = get_tcs_s ts
480 -- The lists are always small => appending is fine
481 get_tcs_s :: [IfaceType] -> [IfaceExtName]
482 get_tcs_s tys = foldr ((++) . get_tcs) [] tys
486 getIfCtxt :: IfL (Module, SDoc)
487 getIfCtxt = do { env <- getLclEnv; return (if_mod env, if_loc env) }
491 %*********************************************************
495 %*********************************************************
497 Extract the gates of an instance declaration
500 ifaceInstGates :: IfaceType -> (IfaceExtName, [IfaceTyCon])
501 -- Return the class, and the tycons mentioned in the rest of the head
502 -- We only pick the TyCon at the root of each type, to avoid
503 -- difficulties with overlap. For example, suppose there are interfaces
508 -- Then, if we are trying to resolve (C Int x), we need the first
509 -- if we are trying to resolve (C x [y]), we need *both* the latter
510 -- two, even though T is not involved yet, so that we spot the overlap
512 ifaceInstGates (IfaceForAllTy _ t) = ifaceInstGates t
513 ifaceInstGates (IfaceFunTy _ t) = ifaceInstGates t
514 ifaceInstGates (IfacePredTy (IfaceClassP cls tys)) = instHeadGates cls tys
515 ifaceInstGates other = pprPanic "ifaceInstGates" (ppr other)
516 -- The other cases should not happen
518 instHeadGates cls tys = (cls, mapCatMaybes root_tycon tys)
520 root_tycon (IfaceFunTy _ _) = Just (IfaceTc funTyConExtName)
521 root_tycon (IfaceTyConApp tc _) = Just tc
522 root_tycon other = Nothing
524 funTyConExtName = mkIfaceExtName (tyConName funTyCon)
527 predInstGates :: Class -> [Type] -> (Name, [Name])
528 -- The same function, only this time on the predicate found in a dictionary
529 predInstGates cls tys
530 = (className cls, mapCatMaybes root_tycon tys)
532 root_tycon ty = case tcSplitTyConApp_maybe ty of
533 Just (tc, _) -> Just (tyConName tc)
538 %*********************************************************
540 \subsection{Reading an interface file}
542 %*********************************************************
545 findAndReadIface :: Bool -- True <=> explicit user import
547 -> IsBootInterface -- True <=> Look for a .hi-boot file
548 -- False <=> Look for .hi file
549 -> IfM lcl (MaybeErr Message (ModIface, FilePath))
550 -- Nothing <=> file not found, or unreadable, or illegible
551 -- Just x <=> successfully found and parsed
553 -- It *doesn't* add an error to the monad, because
554 -- sometimes it's ok to fail... see notes with loadInterface
556 findAndReadIface explicit doc_str mod_name hi_boot_file
557 = do { traceIf (sep [hsep [ptext SLIT("Reading"),
559 then ptext SLIT("[boot]")
561 ptext SLIT("interface for"),
562 ppr mod_name <> semi],
563 nest 4 (ptext SLIT("reason:") <+> doc_str)])
565 -- Check for GHC.Prim, and return its static interface
567 ; let base_pkg = basePackageId (pkgState dflags)
568 ; if mod_name == gHC_PRIM
569 then returnM (Succeeded (ghcPrimIface{ mi_package = base_pkg },
570 "<built in interface for GHC.Prim>"))
574 ; mb_found <- ioToIOEnv (findHiFile dflags explicit mod_name hi_boot_file)
577 { traceIf (ptext SLIT("...not found"))
579 ; returnM (Failed (noIfaceErr dflags mod_name err)) } ;
581 Succeeded (file_path, pkg) -> do
583 -- Found file, so read it
584 { traceIf (ptext SLIT("readIFace") <+> text file_path)
585 ; read_result <- readIface mod_name file_path hi_boot_file
586 ; case read_result of
587 Failed err -> returnM (Failed (badIfaceFile file_path err))
589 | mi_module iface /= mod_name ->
590 return (Failed (wrongIfaceModErr iface mod_name file_path))
592 returnM (Succeeded (iface{mi_package=pkg}, file_path))
593 -- Don't forget to fill in the package name...
596 findHiFile :: DynFlags -> Bool -> Module -> IsBootInterface
597 -> IO (MaybeErr FindResult (FilePath, PackageIdH))
598 findHiFile dflags explicit mod_name hi_boot_file
600 -- In interactive or --make mode, we are *not allowed* to demand-load
601 -- a home package .hi file. So don't even look for them.
602 -- This helps in the case where you are sitting in eg. ghc/lib/std
603 -- and start up GHCi - it won't complain that all the modules it tries
604 -- to load are found in the home location.
605 ghci_mode <- readIORef v_GhcMode ;
606 let { home_allowed = hi_boot_file ||
607 not (isCompManagerMode ghci_mode) } ;
608 maybe_found <- if home_allowed
609 then findModule dflags mod_name explicit
610 else findPackageModule dflags mod_name explicit;
614 | hi_boot_file -> do { hi_boot_path <- hiBootFilePath loc
615 ; return (Succeeded (hi_boot_path, pkg)) }
616 | otherwise -> return (Succeeded (ml_hi_file loc, pkg)) ;
617 err -> return (Failed err)
621 @readIface@ tries just the one file.
624 readIface :: Module -> String -> IsBootInterface
625 -> IfM lcl (MaybeErr Message ModIface)
626 -- Failed err <=> file not found, or unreadable, or illegible
627 -- Succeeded iface <=> successfully found and parsed
629 readIface wanted_mod_name file_path is_hi_boot_file
630 = do { dflags <- getDOpts
631 ; ioToIOEnv (read_iface dflags wanted_mod_name file_path is_hi_boot_file) }
633 read_iface dflags wanted_mod file_path is_hi_boot_file
634 | is_hi_boot_file -- Read ascii
635 = do { res <- tryMost (hGetStringBuffer file_path) ;
637 Left exn -> return (Failed (text (showException exn))) ;
639 case unP parseIface (mkPState buffer loc dflags) of
640 PFailed span err -> return (Failed (mkLocMessage span err))
642 | wanted_mod == actual_mod -> return (Succeeded iface)
643 | otherwise -> return (Failed err)
645 actual_mod = mi_module iface
646 err = hiModuleNameMismatchWarn wanted_mod actual_mod
649 | otherwise -- Read binary
650 = do { res <- tryMost (readBinIface file_path)
652 Right iface -> return (Succeeded iface)
653 Left exn -> return (Failed (text (showException exn))) }
655 loc = mkSrcLoc (mkFastString file_path) 1 0
659 %*********************************************************
661 Wired-in interface for GHC.Prim
663 %*********************************************************
666 initExternalPackageState :: ExternalPackageState
667 initExternalPackageState
669 eps_is_boot = emptyModuleEnv,
670 eps_PIT = emptyPackageIfaceTable,
671 eps_PTE = emptyTypeEnv,
672 eps_inst_env = emptyInstEnv,
673 eps_rule_base = emptyRuleBase,
674 eps_insts = emptyNameEnv,
675 eps_rules = addRulesToPool [] (map mk_gated_rule builtinRules),
676 -- Initialise the EPS rule pool with the built-in rules
677 eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
678 , n_insts_in = 0, n_insts_out = 0
679 , n_rules_in = length builtinRules, n_rules_out = 0 }
682 mk_gated_rule (fn_name, core_rule)
683 = ([fn_name], (nameModule fn_name, ptext SLIT("<built-in rule>"),
684 IfaceBuiltinRule (mkIfaceExtName fn_name) core_rule))
688 %*********************************************************
690 Wired-in interface for GHC.Prim
692 %*********************************************************
695 ghcPrimIface :: ModIface
697 = (emptyModIface HomePackage gHC_PRIM) {
698 mi_exports = [(gHC_PRIM, ghcPrimExports)],
700 mi_fixities = fixities,
701 mi_fix_fn = mkIfaceFixCache fixities
704 fixities = [(getOccName seqId, Fixity 0 InfixR)]
708 %*********************************************************
710 \subsection{Statistics}
712 %*********************************************************
715 ifaceStats :: ExternalPackageState -> SDoc
717 = hcat [text "Renamer stats: ", msg]
719 stats = eps_stats eps
721 [int (n_ifaces_in stats) <+> text "interfaces read",
722 hsep [ int (n_decls_out stats), text "type/class/variable imported, out of",
723 int (n_decls_in stats), text "read"],
724 hsep [ int (n_insts_out stats), text "instance decls imported, out of",
725 int (n_insts_in stats), text "read"],
726 hsep [ int (n_rules_out stats), text "rule decls imported, out of",
727 int (n_rules_in stats), text "read"]
732 %*********************************************************
736 %*********************************************************
739 badIfaceFile file err
740 = vcat [ptext SLIT("Bad interface file:") <+> text file,
743 hiModuleNameMismatchWarn :: Module -> Module -> Message
744 hiModuleNameMismatchWarn requested_mod read_mod =
745 hsep [ ptext SLIT("Something is amiss; requested module name")
747 , ptext SLIT("differs from name found in the interface file")
751 noIfaceErr :: DynFlags -> Module -> FindResult -> SDoc
752 noIfaceErr dflags mod_name (PackageHidden pkg)
753 = ptext SLIT("Could not import") <+> quotes (ppr mod_name) <> colon
754 $$ ptext SLIT("it is a member of package") <+> ppr pkg <> comma
755 <+> ptext SLIT("which is hidden")
757 noIfaceErr dflags mod_name (ModuleHidden pkg)
758 = ptext SLIT("Could not import") <+> quotes (ppr mod_name) <> colon
759 $$ ptext SLIT("it is hidden")
760 <+> parens (ptext SLIT("in package") <+> ppr pkg)
762 noIfaceErr dflags mod_name (NotFound files)
763 = ptext SLIT("Could not find interface file for") <+> quotes (ppr mod_name)
767 | verbosity dflags < 3 =
768 text "(use -v to see a list of the files searched for)"
770 hang (ptext SLIT("locations searched:")) 4 (vcat (map text files))
772 wrongIfaceModErr iface mod_name file_path
773 = sep [ptext SLIT("Interface file") <+> iface_file,
774 ptext SLIT("contains module") <+> quotes (ppr (mi_module iface)) <> comma,
775 ptext SLIT("but we were expecting module") <+> quotes (ppr mod_name),
776 sep [ptext SLIT("Probable cause: the source code which generated"),
778 ptext SLIT("has an incompatible module name")
781 where iface_file = doubleQuotes (text file_path)