2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section{Dealing with interface files}
8 loadHomeInterface, loadInterface,
9 loadSrcInterface, loadOrphanModules,
10 readIface, -- Used when reading the module's old interface
11 predInstGates, ifaceInstGates, ifaceStats, discardDeclPrags,
12 initExternalPackageState
15 #include "HsVersions.h"
17 import {-# SOURCE #-} TcIface( tcIfaceDecl )
19 import DriverState ( v_GhcMode, isCompManagerMode )
20 import DriverUtil ( replaceFilenameSuffix )
21 import CmdLineOpts ( DynFlags( verbosity ), DynFlag( Opt_IgnoreInterfacePragmas ),
23 import Parser ( parseIface )
25 import IfaceSyn ( IfaceDecl(..), IfaceConDecls(..), IfaceConDecl(..), IfaceClassOp(..),
26 IfaceInst(..), IfaceRule(..), IfaceExpr(..), IfaceTyCon(..), IfaceIdInfo(..),
27 IfaceType(..), IfacePredType(..), IfaceExtName, visibleIfConDecls, mkIfaceExtName )
28 import IfaceEnv ( newGlobalBinder, lookupIfaceExt, lookupIfaceTc )
29 import HscTypes ( HscEnv(..), ModIface(..), TyThing, emptyModIface, EpsStats(..), addEpsInStats,
30 ExternalPackageState(..), PackageTypeEnv, emptyTypeEnv,
31 lookupIfaceByModName, emptyPackageIfaceTable,
32 IsBootInterface, mkIfaceFixCache, mkTypeEnv,
33 Gated, implicitTyThings,
34 addRulesToPool, addInstsToPool
37 import BasicTypes ( Version, Fixity(..), FixityDirection(..), isMarkedStrict )
38 import TcType ( Type, tcSplitTyConApp_maybe )
39 import Type ( funTyCon )
42 import PrelNames ( gHC_PRIM_Name )
43 import PrelInfo ( ghcPrimExports, wiredInThings )
44 import PrelRules ( builtinRules )
45 import Rules ( emptyRuleBase )
46 import InstEnv ( emptyInstEnv )
47 import Name ( Name {-instance NamedThing-}, getOccName,
48 nameModuleName, isInternalName )
51 import Packages ( basePackage )
52 import Module ( Module, ModuleName, ModLocation(ml_hi_file),
53 moduleName, isHomeModule, emptyModuleEnv, moduleEnvElts,
54 extendModuleEnv, lookupModuleEnvByName, moduleUserString
56 import OccName ( OccName, mkOccEnv, lookupOccEnv, mkClassTyConOcc, mkClassDataConOcc,
57 mkSuperDictSelOcc, mkDataConWrapperOcc, mkDataConWorkerOcc )
58 import Class ( Class, className )
59 import TyCon ( tyConName )
60 import SrcLoc ( mkSrcLoc, importedSrcLoc )
61 import Maybes ( isJust, mapCatMaybes )
62 import StringBuffer ( hGetStringBuffer )
63 import FastString ( mkFastString )
64 import ErrUtils ( Message, mkLocMessage )
65 import Finder ( findModule, findPackageModule,
66 hiBootExt, hiBootVerExt )
69 import BinIface ( readBinIface )
73 import DATA_IOREF ( readIORef )
79 %************************************************************************
81 loadSrcInterface, loadOrphanModules
83 These two are called from TcM-land
85 %************************************************************************
88 loadSrcInterface :: SDoc -> ModuleName -> IsBootInterface -> RnM ModIface
89 -- This is called for each 'import' declaration in the source code
90 -- On a failure, fail in the monad with an error message
92 loadSrcInterface doc mod_name want_boot
93 = do { mb_iface <- initIfaceTcRn $ loadInterface doc mod_name
94 (ImportByUser want_boot)
96 Left err -> failWithTc (elaborate err)
97 Right iface -> return iface
100 elaborate err = hang (ptext SLIT("Failed to load interface for") <+>
101 quotes (ppr mod_name) <> colon) 4 err
103 loadOrphanModules :: [ModuleName] -> TcM ()
104 loadOrphanModules mods
105 | null mods = returnM ()
106 | otherwise = initIfaceTcRn $
107 do { traceIf (text "Loading orphan modules:" <+>
112 load mod = loadSysInterface (mk_doc mod) mod
113 mk_doc mod = ppr mod <+> ptext SLIT("is a orphan-instance module")
116 %*********************************************************
119 Called from Iface-land
121 %*********************************************************
124 loadHomeInterface :: SDoc -> Name -> IfM lcl ModIface
125 loadHomeInterface doc name
126 = ASSERT2( not (isInternalName name), ppr name <+> parens doc )
127 loadSysInterface doc (nameModuleName name)
129 loadSysInterface :: SDoc -> ModuleName -> IfM lcl ModIface
130 -- A wrapper for loadInterface that Throws an exception if it fails
131 loadSysInterface doc mod_name
132 = do { mb_iface <- loadInterface doc mod_name ImportBySystem
134 Left err -> ghcError (ProgramError (showSDoc err))
135 Right iface -> return iface }
139 %*********************************************************
143 The main function to load an interface
144 for an imported module, and put it in
145 the External Package State
147 %*********************************************************
150 loadInterface :: SDoc -> ModuleName -> WhereFrom
151 -> IfM lcl (Either Message ModIface)
152 -- If it can't find a suitable interface file, we
153 -- a) modify the PackageIfaceTable to have an empty entry
154 -- (to avoid repeated complaints)
155 -- b) return (Left message)
157 -- It's not necessarily an error for there not to be an interface
158 -- file -- perhaps the module has changed, and that interface
159 -- is no longer used -- but the caller can deal with that by
160 -- catching the exception
162 loadInterface doc_str mod_name from
163 = do { -- Read the state
164 (eps,hpt) <- getEpsAndHpt
166 -- Check whether we have the interface already
167 ; case lookupIfaceByModName hpt (eps_PIT eps) mod_name of {
169 -> returnM (Right iface) ; -- Already loaded
170 -- The (src_imp == mi_boot iface) test checks that the already-loaded
171 -- interface isn't a boot iface. This can conceivably happen,
172 -- if an earlier import had a before we got to real imports. I think.
175 { let { hi_boot_file = case from of
176 ImportByUser usr_boot -> usr_boot
177 ImportBySystem -> sys_boot
179 ; mb_dep = lookupModuleEnvByName (eps_is_boot eps) mod_name
180 ; sys_boot = case mb_dep of
181 Just (_, is_boot) -> is_boot
183 -- The boot-ness of the requested interface,
184 } -- based on the dependencies in directly-imported modules
186 -- READ THE MODULE IN
187 ; read_result <- findAndReadIface doc_str mod_name hi_boot_file
188 ; case read_result of {
190 { let fake_iface = emptyModIface opt_InPackage mod_name
192 ; updateEps_ $ \eps ->
193 eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface }
194 -- Not found, so add an empty iface to
195 -- the EPS map so that we don't look again
197 ; returnM (Left err) } ;
202 let { mod = mi_module iface
203 ; mod_name = moduleName mod } in
205 -- Sanity check. If we're system-importing a module we know nothing at all
206 -- about, it should be from a different package to this one
207 WARN( case from of { ImportBySystem -> True; other -> False } &&
208 not (isJust mb_dep) &&
210 ppr mod $$ ppr mb_dep $$ ppr (eps_is_boot eps) )
212 initIfaceLcl mod_name $ do
213 -- Load the new ModIface into the External Package State
214 -- Even home-package interfaces loaded by loadInterface
215 -- (which only happens in OneShot mode; in Batch/Interactive
216 -- mode, home-package modules are loaded one by one into the HPT)
217 -- are put in the EPS.
219 -- The main thing is to add the ModIface to the PIT, but
221 -- IfaceDecls, IfaceInst, IfaceRules
222 -- out of the ModIface and put them into the big EPS pools
224 -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
225 --- names is done correctly (notably, whether this is an .hi file or .hi-boot file).
226 -- If we do loadExport first the wrong info gets into the cache (unless we
227 -- explicitly tag each export which seems a bit of a bore)
229 { ignore_prags <- doptM Opt_IgnoreInterfacePragmas
230 ; new_eps_decls <- loadDecls ignore_prags mod (mi_decls iface)
231 ; new_eps_rules <- loadRules ignore_prags mod_name (mi_rules iface)
232 ; new_eps_insts <- loadInsts mod_name (mi_insts iface)
234 ; let { final_iface = iface { mi_decls = panic "No mi_decls in PIT",
235 mi_insts = panic "No mi_insts in PIT",
236 mi_rules = panic "No mi_rules in PIT" } }
238 ; traceIf (text "Extending PTE" <+> ppr (map fst (concat new_eps_decls)))
240 ; updateEps_ $ \ eps ->
241 eps { eps_PIT = extendModuleEnv (eps_PIT eps) mod final_iface,
242 eps_PTE = addDeclsToPTE (eps_PTE eps) new_eps_decls,
243 eps_rules = addRulesToPool (eps_rules eps) new_eps_rules,
244 eps_insts = addInstsToPool (eps_insts eps) new_eps_insts,
245 eps_stats = addEpsInStats (eps_stats eps) (length new_eps_decls)
246 (length new_eps_insts) (length new_eps_rules) }
248 ; return (Right final_iface)
251 -----------------------------------------------------
252 -- Loading type/class/value decls
253 -- We pass the full Module name here, replete with
254 -- its package info, so that we can build a Name for
255 -- each binder with the right package info in it
256 -- All subsequent lookups, including crucially lookups during typechecking
257 -- the declaration itself, will find the fully-glorious Name
258 -----------------------------------------------------
260 addDeclsToPTE :: PackageTypeEnv -> [[(Name,TyThing)]] -> PackageTypeEnv
261 addDeclsToPTE pte things = foldl extendNameEnvList pte things
263 loadDecls :: Bool -- Don't load pragmas into the decl pool
265 -> [(Version, IfaceDecl)]
266 -> IfL [[(Name,TyThing)]] -- The list can be poked eagerly, but the
267 -- TyThings are forkM'd thunks
268 loadDecls ignore_prags mod decls = mapM (loadDecl ignore_prags mod) decls
270 loadDecl ignore_prags mod (_version, decl)
271 = do { -- Populate the name cache with final versions of all
272 -- the names associated with the decl
273 main_name <- mk_new_bndr Nothing (ifName decl)
274 ; implicit_names <- mapM (mk_new_bndr (Just main_name)) (ifaceDeclSubBndrs decl)
276 -- Typecheck the thing, lazily
277 ; thing <- forkM doc (bumpDeclStats main_name >> tcIfaceDecl decl)
278 ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
279 lookup n = case lookupOccEnv mini_env (getOccName n) of
281 Nothing -> pprPanic "loadDecl" (ppr main_name <+> ppr n)
283 ; returnM ((main_name, thing) : [(n, lookup n) | n <- implicit_names]) }
284 -- We build a list from the *known* names, with (lookup n) thunks
285 -- as the TyThings. That way we can extend the PTE without poking the
288 decl' | ignore_prags = discardDeclPrags decl
291 -- mk_new_bndr allocates in the name cache the final canonical
292 -- name for the thing, with the correct
296 -- imported name, to fix the module correctly in the cache
297 mk_new_bndr mb_parent occ = newGlobalBinder mod occ mb_parent loc
298 loc = importedSrcLoc (moduleUserString mod)
299 doc = ptext SLIT("Declaration for") <+> ppr (ifName decl)
301 discardDeclPrags :: IfaceDecl -> IfaceDecl
302 discardDeclPrags decl@(IfaceId {ifIdInfo = HasInfo _}) = decl { ifIdInfo = NoInfo }
303 discardDeclPrags decl = decl
305 bumpDeclStats :: Name -> IfL () -- Record that one more declaration has actually been used
307 = do { traceIf (text "Loading decl for" <+> ppr name)
308 ; updateEps_ (\eps -> let stats = eps_stats eps
309 in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })
313 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
314 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
315 -- Deeply revolting, because it has to predict what gets bound,
316 -- especially the question of whether there's a wrapper for a datacon
318 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ, ifSigs = sigs })
319 = [tc_occ, dc_occ, dcww_occ] ++
320 [op | IfaceClassOp op _ _ <- sigs] ++
321 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]]
323 n_ctxt = length sc_ctxt
325 tc_occ = mkClassTyConOcc cls_occ
326 dc_occ = mkClassDataConOcc cls_occ
327 dcww_occ | is_newtype = mkDataConWrapperOcc dc_occ -- Newtypes have wrapper but no worker
328 | otherwise = mkDataConWorkerOcc dc_occ -- Otherwise worker but no wrapper
329 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
331 ifaceDeclSubBndrs (IfaceData {ifCons = IfAbstractTyCon})
333 ifaceDeclSubBndrs (IfaceData {ifCons = IfNewTyCon (IfaceConDecl con_occ _ _ _ _ _ fields)})
334 = fields ++ [con_occ, mkDataConWrapperOcc con_occ]
335 -- Wrapper, no worker; see MkId.mkDataConIds
337 ifaceDeclSubBndrs (IfaceData {ifCons = IfDataTyCon cons})
338 = nub (concatMap fld_occs cons) -- Eliminate duplicate fields
339 ++ concatMap dc_occs cons
341 fld_occs (IfaceConDecl _ _ _ _ _ _ fields) = fields
342 dc_occs (IfaceConDecl con_occ _ _ _ _ strs _)
343 | has_wrapper = [con_occ, work_occ, wrap_occ]
344 | otherwise = [con_occ, work_occ]
346 wrap_occ = mkDataConWrapperOcc con_occ
347 work_occ = mkDataConWorkerOcc con_occ
348 has_wrapper = any isMarkedStrict strs -- See MkId.mkDataConIds (sigh)
349 -- ToDo: may miss strictness in existential dicts
351 ifaceDeclSubBndrs _other = []
354 -----------------------------------------------------
355 -- Loading instance decls
356 -----------------------------------------------------
358 loadInsts :: ModuleName -> [IfaceInst] -> IfL [(Name, Gated IfaceInst)]
359 loadInsts mod decls = mapM (loadInstDecl mod) decls
361 loadInstDecl mod decl@(IfaceInst {ifInstHead = inst_ty})
363 -- Find out what type constructors and classes are "gates" for the
364 -- instance declaration. If all these "gates" are slurped in then
365 -- we should slurp the instance decl too.
367 -- We *don't* want to count names in the context part as gates, though.
369 -- instance Foo a => Baz (T a) where ...
371 -- Here the gates are Baz and T, but *not* Foo.
373 -- HOWEVER: functional dependencies make things more complicated
374 -- class C a b | a->b where ...
375 -- instance C Foo Baz where ...
376 -- Here, the gates are really only C and Foo, *not* Baz.
377 -- That is, if C and Foo are visible, even if Baz isn't, we must
380 -- Rather than take fundeps into account "properly", we just slurp
381 -- if C is visible and *any one* of the Names in the types
382 -- This is a slightly brutal approximation, but most instance decls
383 -- are regular H98 ones and it's perfect for them.
385 -- NOTICE that we rename the type before extracting its free
386 -- variables. The free-variable finder for a renamed HsType
387 -- does the Right Thing for built-in syntax like [] and (,).
388 let { (cls_ext, tc_exts) = ifaceInstGates inst_ty }
389 ; cls <- lookupIfaceExt cls_ext
390 ; tcs <- mapM lookupIfaceTc tc_exts
391 ; returnM (cls, (tcs, (mod,decl)))
394 -----------------------------------------------------
396 -----------------------------------------------------
398 loadRules :: Bool -- Don't load pragmas into the decl pool
400 -> [IfaceRule] -> IfL [Gated IfaceRule]
401 loadRules ignore_prags mod rules
402 | ignore_prags = returnM []
403 | otherwise = mapM (loadRule mod) rules
405 loadRule :: ModuleName -> IfaceRule -> IfL (Gated IfaceRule)
406 -- "Gate" the rule simply by a crude notion of the free vars of
407 -- the LHS. It can be crude, because having too few free vars is safe.
408 loadRule mod decl@(IfaceRule {ifRuleHead = fn, ifRuleArgs = args})
409 = do { names <- mapM lookupIfaceExt (fn : arg_fvs)
410 ; returnM (names, (mod, decl)) }
412 arg_fvs = [n | arg <- args, n <- crudeIfExprGblFvs arg]
415 ---------------------------
416 crudeIfExprGblFvs :: IfaceExpr -> [IfaceExtName]
417 -- A crude approximation to the free external names of an IfExpr
418 -- Returns a subset of the true answer
419 crudeIfExprGblFvs (IfaceType ty) = get_tcs ty
420 crudeIfExprGblFvs (IfaceExt v) = [v]
421 crudeIfExprGblFvs other = [] -- Well, I said it was crude
423 get_tcs :: IfaceType -> [IfaceExtName]
424 -- Get a crude subset of the TyCons of an IfaceType
425 get_tcs (IfaceTyVar _) = []
426 get_tcs (IfaceAppTy t1 t2) = get_tcs t1 ++ get_tcs t2
427 get_tcs (IfaceFunTy t1 t2) = get_tcs t1 ++ get_tcs t2
428 get_tcs (IfaceForAllTy _ t) = get_tcs t
429 get_tcs (IfacePredTy st) = case st of
430 IfaceClassP cl ts -> get_tcs_s ts
431 IfaceIParam _ t -> get_tcs t
432 get_tcs (IfaceTyConApp (IfaceTc tc) ts) = tc : get_tcs_s ts
433 get_tcs (IfaceTyConApp other ts) = get_tcs_s ts
435 -- The lists are always small => appending is fine
436 get_tcs_s :: [IfaceType] -> [IfaceExtName]
437 get_tcs_s tys = foldr ((++) . get_tcs) [] tys
441 %*********************************************************
445 %*********************************************************
447 Extract the gates of an instance declaration
450 ifaceInstGates :: IfaceType -> (IfaceExtName, [IfaceTyCon])
451 -- Return the class, and the tycons mentioned in the rest of the head
452 -- We only pick the TyCon at the root of each type, to avoid
453 -- difficulties with overlap. For example, suppose there are interfaces
458 -- Then, if we are trying to resolve (C Int x), we need the first
459 -- if we are trying to resolve (C x [y]), we need *both* the latter
460 -- two, even though T is not involved yet, so that we spot the overlap
462 ifaceInstGates (IfaceForAllTy _ t) = ifaceInstGates t
463 ifaceInstGates (IfaceFunTy _ t) = ifaceInstGates t
464 ifaceInstGates (IfacePredTy (IfaceClassP cls tys)) = instHeadGates cls tys
465 ifaceInstGates other = pprPanic "ifaceInstGates" (ppr other)
466 -- The other cases should not happen
468 instHeadGates cls tys = (cls, mapCatMaybes root_tycon tys)
470 root_tycon (IfaceFunTy _ _) = Just (IfaceTc funTyConExtName)
471 root_tycon (IfaceTyConApp tc _) = Just tc
472 root_tycon other = Nothing
474 funTyConExtName = mkIfaceExtName (tyConName funTyCon)
477 predInstGates :: Class -> [Type] -> (Name, [Name])
478 -- The same function, only this time on the predicate found in a dictionary
479 predInstGates cls tys
480 = (className cls, mapCatMaybes root_tycon tys)
482 root_tycon ty = case tcSplitTyConApp_maybe ty of
483 Just (tc, _) -> Just (tyConName tc)
488 %*********************************************************
490 \subsection{Reading an interface file}
492 %*********************************************************
495 findAndReadIface :: SDoc -> ModuleName
496 -> IsBootInterface -- True <=> Look for a .hi-boot file
497 -- False <=> Look for .hi file
498 -> IfM lcl (Either Message ModIface)
499 -- Nothing <=> file not found, or unreadable, or illegible
500 -- Just x <=> successfully found and parsed
502 -- It *doesn't* add an error to the monad, because
503 -- sometimes it's ok to fail... see notes with loadInterface
505 findAndReadIface doc_str mod_name hi_boot_file
506 = do { traceIf (sep [hsep [ptext SLIT("Reading"),
508 then ptext SLIT("[boot]")
510 ptext SLIT("interface for"),
511 ppr mod_name <> semi],
512 nest 4 (ptext SLIT("reason:") <+> doc_str)])
514 -- Check for GHC.Prim, and return its static interface
515 ; if mod_name == gHC_PRIM_Name
516 then returnM (Right ghcPrimIface)
520 ; mb_found <- ioToIOEnv (findHiFile mod_name hi_boot_file)
523 { traceIf (ptext SLIT("...not found"))
525 ; returnM (Left (noIfaceErr dflags mod_name hi_boot_file files)) } ;
527 Right file_path -> do
529 -- Found file, so read it
530 { traceIf (ptext SLIT("readIFace") <+> text file_path)
531 ; read_result <- readIface mod_name file_path hi_boot_file
532 ; case read_result of
533 Left err -> returnM (Left (badIfaceFile file_path err))
535 | moduleName (mi_module iface) /= mod_name ->
536 return (Left (wrongIfaceModErr iface mod_name file_path))
538 returnM (Right iface)
541 findHiFile :: ModuleName -> IsBootInterface
542 -> IO (Either [FilePath] FilePath)
543 findHiFile mod_name hi_boot_file
545 -- In interactive or --make mode, we are *not allowed* to demand-load
546 -- a home package .hi file. So don't even look for them.
547 -- This helps in the case where you are sitting in eg. ghc/lib/std
548 -- and start up GHCi - it won't complain that all the modules it tries
549 -- to load are found in the home location.
550 ghci_mode <- readIORef v_GhcMode ;
551 let { home_allowed = hi_boot_file ||
552 not (isCompManagerMode ghci_mode) } ;
553 maybe_found <- if home_allowed
554 then findModule mod_name
555 else findPackageModule mod_name ;
557 case maybe_found of {
558 Left files -> return (Left files) ;
560 Right (_, loc) -> do { -- Don't need module returned by finder
562 -- Return the path to M.hi, M.hi-boot, or M.hi-boot-n as appropriate
563 let { hi_path = ml_hi_file loc ;
564 hi_boot_path = replaceFilenameSuffix hi_path hiBootExt ;
565 hi_boot_ver_path = replaceFilenameSuffix hi_path hiBootVerExt
568 if not hi_boot_file then
569 return (Right hi_path)
571 hi_ver_exists <- doesFileExist hi_boot_ver_path ;
572 if hi_ver_exists then return (Right hi_boot_ver_path)
573 else return (Right hi_boot_path)
577 @readIface@ tries just the one file.
580 readIface :: ModuleName -> String -> IsBootInterface
581 -> IfM lcl (Either Message ModIface)
582 -- Left err <=> file not found, or unreadable, or illegible
583 -- Right iface <=> successfully found and parsed
585 readIface wanted_mod_name file_path is_hi_boot_file
586 = do { dflags <- getDOpts
587 ; ioToIOEnv (read_iface dflags wanted_mod_name file_path is_hi_boot_file) }
589 read_iface dflags wanted_mod file_path is_hi_boot_file
590 | is_hi_boot_file -- Read ascii
591 = do { res <- tryMost (hGetStringBuffer file_path) ;
593 Left exn -> return (Left (text (showException exn))) ;
595 case unP parseIface (mkPState buffer loc dflags) of
596 PFailed span err -> return (Left (mkLocMessage span err))
598 | wanted_mod == actual_mod -> return (Right iface)
599 | otherwise -> return (Left err)
601 actual_mod = moduleName (mi_module iface)
602 err = hiModuleNameMismatchWarn wanted_mod actual_mod
605 | otherwise -- Read binary
606 = do { res <- tryMost (readBinIface file_path)
608 Right iface -> return (Right iface)
609 Left exn -> return (Left (text (showException exn))) }
611 loc = mkSrcLoc (mkFastString file_path) 1 0
615 %*********************************************************
617 Wired-in interface for GHC.Prim
619 %*********************************************************
622 initExternalPackageState :: ExternalPackageState
623 initExternalPackageState
625 eps_is_boot = emptyModuleEnv,
626 eps_PIT = emptyPackageIfaceTable,
627 eps_PTE = emptyTypeEnv,
628 eps_inst_env = emptyInstEnv,
629 eps_rule_base = emptyRuleBase,
630 eps_insts = emptyNameEnv,
631 eps_rules = addRulesToPool [] (map mk_gated_rule builtinRules),
632 -- Initialise the EPS rule pool with the built-in rules
633 eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
634 , n_insts_in = 0, n_insts_out = 0
635 , n_rules_in = length builtinRules, n_rules_out = 0 }
638 mk_gated_rule (fn_name, core_rule)
639 = ([fn_name], (nameModuleName fn_name, IfaceBuiltinRule (mkIfaceExtName fn_name) core_rule))
643 %*********************************************************
645 Wired-in interface for GHC.Prim
647 %*********************************************************
650 ghcPrimIface :: ModIface
652 = (emptyModIface basePackage gHC_PRIM_Name) {
653 mi_exports = [(gHC_PRIM_Name, ghcPrimExports)],
655 mi_fixities = fixities,
656 mi_fix_fn = mkIfaceFixCache fixities
659 fixities = [(getOccName seqId, Fixity 0 InfixR)]
663 %*********************************************************
665 \subsection{Statistics}
667 %*********************************************************
670 ifaceStats :: ExternalPackageState -> SDoc
672 = hcat [text "Renamer stats: ", msg]
674 stats = eps_stats eps
676 [int (n_ifaces_in stats) <+> text "interfaces read",
677 hsep [ int (n_decls_out stats), text "type/class/variable imported, out of",
678 int (n_decls_in stats), text "read"],
679 hsep [ int (n_insts_out stats), text "instance decls imported, out of",
680 int (n_insts_in stats), text "read"],
681 hsep [ int (n_rules_out stats), text "rule decls imported, out of",
682 int (n_rules_in stats), text "read"]
687 %*********************************************************
691 %*********************************************************
694 badIfaceFile file err
695 = vcat [ptext SLIT("Bad interface file:") <+> text file,
698 hiModuleNameMismatchWarn :: ModuleName -> ModuleName -> Message
699 hiModuleNameMismatchWarn requested_mod read_mod =
700 hsep [ ptext SLIT("Something is amiss; requested module name")
702 , ptext SLIT("differs from name found in the interface file")
706 noIfaceErr dflags mod_name boot_file files
707 = ptext SLIT("Could not find interface file for") <+> quotes (ppr mod_name)
711 | verbosity dflags < 3 =
712 text "(use -v to see a list of the files searched for)"
714 hang (ptext SLIT("locations searched:")) 4 (vcat (map text files))
716 wrongIfaceModErr iface mod_name file_path
717 = sep [ptext SLIT("Interface file") <+> iface_file,
718 ptext SLIT("contains module") <+> quotes (ppr (mi_module iface)) <> comma,
719 ptext SLIT("but we were expecting module") <+> quotes (ppr mod_name),
720 sep [ptext SLIT("Probable cause: the source code which generated"),
722 ptext SLIT("has an incompatible module name")
725 where iface_file = doubleQuotes (text file_path)