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
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(..), IfaceConDecl(..), IfaceClassOp(..), IfaceConDecls(..),
26 IfaceInst(..), IfaceRule(..), IfaceExpr(..), IfaceTyCon(..), IfaceIdInfo(..),
27 IfaceType(..), IfacePredType(..), IfaceExtName, mkIfaceExtName )
28 import IfaceEnv ( newGlobalBinder, lookupIfaceExt, lookupIfaceTc, lookupOrig )
29 import HscTypes ( ModIface(..), TyThing, emptyModIface, EpsStats(..), addEpsInStats,
30 ExternalPackageState(..), PackageTypeEnv, emptyTypeEnv,
31 lookupIfaceByModName, emptyPackageIfaceTable,
32 IsBootInterface, mkIfaceFixCache, Gated, implicitTyThings,
33 addRulesToPool, addInstsToPool, availNames
36 import BasicTypes ( Version, Fixity(..), FixityDirection(..), isMarkedStrict )
37 import TcType ( Type, tcSplitTyConApp_maybe )
38 import Type ( funTyCon )
41 import PrelNames ( gHC_PRIM_Name )
42 import PrelInfo ( ghcPrimExports )
43 import PrelRules ( builtinRules )
44 import Rules ( emptyRuleBase )
45 import InstEnv ( emptyInstEnv )
46 import Name ( Name {-instance NamedThing-}, getOccName,
47 nameModuleName, isInternalName )
50 import Packages ( basePackage )
51 import Module ( Module, ModuleName, ModLocation(ml_hi_file),
52 moduleName, isHomeModule, emptyModuleEnv,
53 extendModuleEnv, lookupModuleEnvByName, lookupModuleEnv,
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 loadHiBootInterface :: TcRn [Name]
104 -- Load the hi-boot iface for the module being compiled,
105 -- if it indeed exists in the transitive closure of imports
106 -- Return the list of names exported by the hi-boot file
111 ; traceIf (text "loadHiBootInterface" <+> ppr mod)
113 -- We're read all the direct imports by now, so eps_is_boot will
114 -- record if any of our imports mention us by way of hi-boot file
115 ; case lookupModuleEnv (eps_is_boot eps) mod of {
116 Nothing -> return [] ; -- The typical case
118 Just (_, False) -> -- Someone below us imported us!
119 -- This is a loop with no hi-boot in the way
120 failWithTc (moduleLoop mod) ;
122 Just (mod_nm, True) -> -- There's a hi-boot interface below us
125 do { -- Load it (into the PTE, and return the exported names
126 iface <- loadSrcInterface (mk_doc mod_nm) mod_nm True
127 ; sequenceM [ lookupOrig mod_nm occ
128 | (mod,avails) <- mi_exports iface,
129 avail <- avails, occ <- availNames avail]
132 mk_doc mod = ptext SLIT("Need the hi-boot interface for") <+> ppr mod
133 <+> ptext SLIT("to compare against the Real Thing")
135 moduleLoop mod = ptext SLIT("Circular imports: module") <+> quotes (ppr mod)
136 <+> ptext SLIT("depends on itself")
138 loadOrphanModules :: [ModuleName] -> TcM ()
139 loadOrphanModules mods
140 | null mods = returnM ()
141 | otherwise = initIfaceTcRn $
142 do { traceIf (text "Loading orphan modules:" <+>
147 load mod = loadSysInterface (mk_doc mod) mod
148 mk_doc mod = ppr mod <+> ptext SLIT("is a orphan-instance module")
151 %*********************************************************
154 Called from Iface-land
156 %*********************************************************
159 loadHomeInterface :: SDoc -> Name -> IfM lcl ModIface
160 loadHomeInterface doc name
161 = ASSERT2( not (isInternalName name), ppr name <+> parens doc )
162 loadSysInterface doc (nameModuleName name)
164 loadSysInterface :: SDoc -> ModuleName -> IfM lcl ModIface
165 -- A wrapper for loadInterface that Throws an exception if it fails
166 loadSysInterface doc mod_name
167 = do { mb_iface <- loadInterface doc mod_name ImportBySystem
169 Left err -> ghcError (ProgramError (showSDoc err))
170 Right iface -> return iface }
174 %*********************************************************
178 The main function to load an interface
179 for an imported module, and put it in
180 the External Package State
182 %*********************************************************
185 loadInterface :: SDoc -> ModuleName -> WhereFrom
186 -> IfM lcl (Either Message ModIface)
187 -- If it can't find a suitable interface file, we
188 -- a) modify the PackageIfaceTable to have an empty entry
189 -- (to avoid repeated complaints)
190 -- b) return (Left message)
192 -- It's not necessarily an error for there not to be an interface
193 -- file -- perhaps the module has changed, and that interface
194 -- is no longer used -- but the caller can deal with that by
195 -- catching the exception
197 loadInterface doc_str mod_name from
198 = do { -- Read the state
199 (eps,hpt) <- getEpsAndHpt
201 ; traceIf (text "Considering whether to load" <+> ppr mod_name <+> ppr from)
203 -- Check whether we have the interface already
204 ; case lookupIfaceByModName hpt (eps_PIT eps) mod_name of {
206 -> returnM (Right iface) ; -- Already loaded
207 -- The (src_imp == mi_boot iface) test checks that the already-loaded
208 -- interface isn't a boot iface. This can conceivably happen,
209 -- if an earlier import had a before we got to real imports. I think.
212 { let { hi_boot_file = case from of
213 ImportByUser usr_boot -> usr_boot
214 ImportBySystem -> sys_boot
216 ; mb_dep = lookupModuleEnvByName (eps_is_boot eps) mod_name
217 ; sys_boot = case mb_dep of
218 Just (_, is_boot) -> is_boot
220 -- The boot-ness of the requested interface,
221 } -- based on the dependencies in directly-imported modules
223 -- READ THE MODULE IN
224 ; read_result <- findAndReadIface doc_str mod_name hi_boot_file
225 ; case read_result of {
227 { let fake_iface = emptyModIface opt_InPackage mod_name
229 ; updateEps_ $ \eps ->
230 eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface }
231 -- Not found, so add an empty iface to
232 -- the EPS map so that we don't look again
234 ; returnM (Left err) } ;
239 let { mod = mi_module iface
240 ; mod_name = moduleName mod } in
242 -- Sanity check. If we're system-importing a module we know nothing at all
243 -- about, it should be from a different package to this one
244 WARN( case from of { ImportBySystem -> True; other -> False } &&
245 not (isJust mb_dep) &&
247 ppr mod $$ ppr mb_dep $$ ppr (eps_is_boot eps) )
249 initIfaceLcl mod_name $ do
250 -- Load the new ModIface into the External Package State
251 -- Even home-package interfaces loaded by loadInterface
252 -- (which only happens in OneShot mode; in Batch/Interactive
253 -- mode, home-package modules are loaded one by one into the HPT)
254 -- are put in the EPS.
256 -- The main thing is to add the ModIface to the PIT, but
258 -- IfaceDecls, IfaceInst, IfaceRules
259 -- out of the ModIface and put them into the big EPS pools
261 -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
262 --- names is done correctly (notably, whether this is an .hi file or .hi-boot file).
263 -- If we do loadExport first the wrong info gets into the cache (unless we
264 -- explicitly tag each export which seems a bit of a bore)
266 { ignore_prags <- doptM Opt_IgnoreInterfacePragmas
267 ; new_eps_decls <- loadDecls ignore_prags mod (mi_decls iface)
268 ; new_eps_rules <- loadRules ignore_prags mod_name (mi_rules iface)
269 ; new_eps_insts <- loadInsts mod_name (mi_insts iface)
271 ; let { final_iface = iface { mi_decls = panic "No mi_decls in PIT",
272 mi_insts = panic "No mi_insts in PIT",
273 mi_rules = panic "No mi_rules in PIT" } }
275 ; updateEps_ $ \ eps ->
276 eps { eps_PIT = extendModuleEnv (eps_PIT eps) mod final_iface,
277 eps_PTE = addDeclsToPTE (eps_PTE eps) new_eps_decls,
278 eps_rules = addRulesToPool (eps_rules eps) new_eps_rules,
279 eps_insts = addInstsToPool (eps_insts eps) new_eps_insts,
280 eps_stats = addEpsInStats (eps_stats eps) (length new_eps_decls)
281 (length new_eps_insts) (length new_eps_rules) }
283 ; return (Right final_iface)
286 -----------------------------------------------------
287 -- Loading type/class/value decls
288 -- We pass the full Module name here, replete with
289 -- its package info, so that we can build a Name for
290 -- each binder with the right package info in it
291 -- All subsequent lookups, including crucially lookups during typechecking
292 -- the declaration itself, will find the fully-glorious Name
293 -----------------------------------------------------
295 addDeclsToPTE :: PackageTypeEnv -> [[(Name,TyThing)]] -> PackageTypeEnv
296 addDeclsToPTE pte things = foldl extendNameEnvList pte things
298 loadDecls :: Bool -- Don't load pragmas into the decl pool
300 -> [(Version, IfaceDecl)]
301 -> IfL [[(Name,TyThing)]] -- The list can be poked eagerly, but the
302 -- TyThings are forkM'd thunks
303 loadDecls ignore_prags mod decls = mapM (loadDecl ignore_prags mod) decls
305 loadDecl ignore_prags mod (_version, decl)
306 = do { -- Populate the name cache with final versions of all
307 -- the names associated with the decl
308 main_name <- mk_new_bndr Nothing (ifName decl)
309 ; implicit_names <- mapM (mk_new_bndr (Just main_name)) (ifaceDeclSubBndrs decl)
311 -- Typecheck the thing, lazily
312 ; thing <- forkM doc (bumpDeclStats main_name >> tcIfaceDecl stripped_decl)
313 ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
314 lookup n = case lookupOccEnv mini_env (getOccName n) of
316 Nothing -> pprPanic "loadDecl" (ppr main_name <+> ppr n)
318 ; returnM ((main_name, thing) : [(n, lookup n) | n <- implicit_names]) }
319 -- We build a list from the *known* names, with (lookup n) thunks
320 -- as the TyThings. That way we can extend the PTE without poking the
323 stripped_decl | ignore_prags = discardDeclPrags decl
326 -- mk_new_bndr allocates in the name cache the final canonical
327 -- name for the thing, with the correct
331 -- imported name, to fix the module correctly in the cache
332 mk_new_bndr mb_parent occ = newGlobalBinder mod occ mb_parent loc
333 loc = importedSrcLoc (moduleUserString mod)
334 doc = ptext SLIT("Declaration for") <+> ppr (ifName decl)
336 discardDeclPrags :: IfaceDecl -> IfaceDecl
337 discardDeclPrags decl@(IfaceId {ifIdInfo = HasInfo _}) = decl { ifIdInfo = NoInfo }
338 discardDeclPrags decl = decl
340 bumpDeclStats :: Name -> IfL () -- Record that one more declaration has actually been used
342 = do { traceIf (text "Loading decl for" <+> ppr name)
343 ; updateEps_ (\eps -> let stats = eps_stats eps
344 in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })
348 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
349 -- *Excludes* the 'main' name, but *includes* the implicitly-bound names
350 -- Deeply revolting, because it has to predict what gets bound,
351 -- especially the question of whether there's a wrapper for a datacon
353 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ, ifSigs = sigs })
354 = [tc_occ, dc_occ, dcww_occ] ++
355 [op | IfaceClassOp op _ _ <- sigs] ++
356 [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]]
358 n_ctxt = length sc_ctxt
360 tc_occ = mkClassTyConOcc cls_occ
361 dc_occ = mkClassDataConOcc cls_occ
362 dcww_occ | is_newtype = mkDataConWrapperOcc dc_occ -- Newtypes have wrapper but no worker
363 | otherwise = mkDataConWorkerOcc dc_occ -- Otherwise worker but no wrapper
364 is_newtype = n_sigs + n_ctxt == 1 -- Sigh
366 ifaceDeclSubBndrs (IfaceData {ifCons = IfAbstractTyCon})
369 ifaceDeclSubBndrs (IfaceData {ifCons = IfNewTyCon (IfVanillaCon { ifConOcc = con_occ,
370 ifConFields = fields})})
371 = fields ++ [con_occ, mkDataConWrapperOcc con_occ]
372 -- Wrapper, no worker; see MkId.mkDataConIds
374 ifaceDeclSubBndrs (IfaceData {ifCons = IfDataTyCon _ cons})
375 = nub (concatMap fld_occs cons) -- Eliminate duplicate fields
376 ++ concatMap dc_occs cons
378 fld_occs (IfVanillaCon { ifConFields = fields }) = fields
379 fld_occs (IfGadtCon {}) = []
381 | has_wrapper = [con_occ, work_occ, wrap_occ]
382 | otherwise = [con_occ, work_occ]
384 con_occ = ifConOcc con_decl
385 strs = ifConStricts con_decl
386 wrap_occ = mkDataConWrapperOcc con_occ
387 work_occ = mkDataConWorkerOcc con_occ
388 has_wrapper = any isMarkedStrict strs -- See MkId.mkDataConIds (sigh)
389 -- ToDo: may miss strictness in existential dicts
391 ifaceDeclSubBndrs _other = []
393 -----------------------------------------------------
394 -- Loading instance decls
395 -----------------------------------------------------
397 loadInsts :: ModuleName -> [IfaceInst] -> IfL [(Name, Gated IfaceInst)]
398 loadInsts mod decls = mapM (loadInstDecl mod) decls
400 loadInstDecl mod decl@(IfaceInst {ifInstHead = inst_ty})
402 -- Find out what type constructors and classes are "gates" for the
403 -- instance declaration. If all these "gates" are slurped in then
404 -- we should slurp the instance decl too.
406 -- We *don't* want to count names in the context part as gates, though.
408 -- instance Foo a => Baz (T a) where ...
410 -- Here the gates are Baz and T, but *not* Foo.
412 -- HOWEVER: functional dependencies make things more complicated
413 -- class C a b | a->b where ...
414 -- instance C Foo Baz where ...
415 -- Here, the gates are really only C and Foo, *not* Baz.
416 -- That is, if C and Foo are visible, even if Baz isn't, we must
419 -- Rather than take fundeps into account "properly", we just slurp
420 -- if C is visible and *any one* of the Names in the types
421 -- This is a slightly brutal approximation, but most instance decls
422 -- are regular H98 ones and it's perfect for them.
424 -- NOTICE that we rename the type before extracting its free
425 -- variables. The free-variable finder for a renamed HsType
426 -- does the Right Thing for built-in syntax like [] and (,).
427 let { (cls_ext, tc_exts) = ifaceInstGates inst_ty }
428 ; cls <- lookupIfaceExt cls_ext
429 ; tcs <- mapM lookupIfaceTc tc_exts
430 ; returnM (cls, (tcs, (mod,decl)))
433 -----------------------------------------------------
435 -----------------------------------------------------
437 loadRules :: Bool -- Don't load pragmas into the decl pool
439 -> [IfaceRule] -> IfL [Gated IfaceRule]
440 loadRules ignore_prags mod rules
441 | ignore_prags = returnM []
442 | otherwise = mapM (loadRule mod) rules
444 loadRule :: ModuleName -> IfaceRule -> IfL (Gated IfaceRule)
445 -- "Gate" the rule simply by a crude notion of the free vars of
446 -- the LHS. It can be crude, because having too few free vars is safe.
447 loadRule mod decl@(IfaceRule {ifRuleHead = fn, ifRuleArgs = args})
448 = do { names <- mapM lookupIfaceExt (fn : arg_fvs)
449 ; returnM (names, (mod, decl)) }
451 arg_fvs = [n | arg <- args, n <- crudeIfExprGblFvs arg]
454 ---------------------------
455 crudeIfExprGblFvs :: IfaceExpr -> [IfaceExtName]
456 -- A crude approximation to the free external names of an IfExpr
457 -- Returns a subset of the true answer
458 crudeIfExprGblFvs (IfaceType ty) = get_tcs ty
459 crudeIfExprGblFvs (IfaceExt v) = [v]
460 crudeIfExprGblFvs other = [] -- Well, I said it was crude
462 get_tcs :: IfaceType -> [IfaceExtName]
463 -- Get a crude subset of the TyCons of an IfaceType
464 get_tcs (IfaceTyVar _) = []
465 get_tcs (IfaceAppTy t1 t2) = get_tcs t1 ++ get_tcs t2
466 get_tcs (IfaceFunTy t1 t2) = get_tcs t1 ++ get_tcs t2
467 get_tcs (IfaceForAllTy _ t) = get_tcs t
468 get_tcs (IfacePredTy st) = case st of
469 IfaceClassP cl ts -> get_tcs_s ts
470 IfaceIParam _ t -> get_tcs t
471 get_tcs (IfaceTyConApp (IfaceTc tc) ts) = tc : get_tcs_s ts
472 get_tcs (IfaceTyConApp other ts) = get_tcs_s ts
474 -- The lists are always small => appending is fine
475 get_tcs_s :: [IfaceType] -> [IfaceExtName]
476 get_tcs_s tys = foldr ((++) . get_tcs) [] tys
480 %*********************************************************
484 %*********************************************************
486 Extract the gates of an instance declaration
489 ifaceInstGates :: IfaceType -> (IfaceExtName, [IfaceTyCon])
490 -- Return the class, and the tycons mentioned in the rest of the head
491 -- We only pick the TyCon at the root of each type, to avoid
492 -- difficulties with overlap. For example, suppose there are interfaces
497 -- Then, if we are trying to resolve (C Int x), we need the first
498 -- if we are trying to resolve (C x [y]), we need *both* the latter
499 -- two, even though T is not involved yet, so that we spot the overlap
501 ifaceInstGates (IfaceForAllTy _ t) = ifaceInstGates t
502 ifaceInstGates (IfaceFunTy _ t) = ifaceInstGates t
503 ifaceInstGates (IfacePredTy (IfaceClassP cls tys)) = instHeadGates cls tys
504 ifaceInstGates other = pprPanic "ifaceInstGates" (ppr other)
505 -- The other cases should not happen
507 instHeadGates cls tys = (cls, mapCatMaybes root_tycon tys)
509 root_tycon (IfaceFunTy _ _) = Just (IfaceTc funTyConExtName)
510 root_tycon (IfaceTyConApp tc _) = Just tc
511 root_tycon other = Nothing
513 funTyConExtName = mkIfaceExtName (tyConName funTyCon)
516 predInstGates :: Class -> [Type] -> (Name, [Name])
517 -- The same function, only this time on the predicate found in a dictionary
518 predInstGates cls tys
519 = (className cls, mapCatMaybes root_tycon tys)
521 root_tycon ty = case tcSplitTyConApp_maybe ty of
522 Just (tc, _) -> Just (tyConName tc)
527 %*********************************************************
529 \subsection{Reading an interface file}
531 %*********************************************************
534 findAndReadIface :: SDoc -> ModuleName
535 -> IsBootInterface -- True <=> Look for a .hi-boot file
536 -- False <=> Look for .hi file
537 -> IfM lcl (Either Message ModIface)
538 -- Nothing <=> file not found, or unreadable, or illegible
539 -- Just x <=> successfully found and parsed
541 -- It *doesn't* add an error to the monad, because
542 -- sometimes it's ok to fail... see notes with loadInterface
544 findAndReadIface doc_str mod_name hi_boot_file
545 = do { traceIf (sep [hsep [ptext SLIT("Reading"),
547 then ptext SLIT("[boot]")
549 ptext SLIT("interface for"),
550 ppr mod_name <> semi],
551 nest 4 (ptext SLIT("reason:") <+> doc_str)])
553 -- Check for GHC.Prim, and return its static interface
554 ; if mod_name == gHC_PRIM_Name
555 then returnM (Right ghcPrimIface)
559 ; mb_found <- ioToIOEnv (findHiFile mod_name hi_boot_file)
562 { traceIf (ptext SLIT("...not found"))
564 ; returnM (Left (noIfaceErr dflags mod_name hi_boot_file files)) } ;
566 Right file_path -> do
568 -- Found file, so read it
569 { traceIf (ptext SLIT("readIFace") <+> text file_path)
570 ; read_result <- readIface mod_name file_path hi_boot_file
571 ; case read_result of
572 Left err -> returnM (Left (badIfaceFile file_path err))
574 | moduleName (mi_module iface) /= mod_name ->
575 return (Left (wrongIfaceModErr iface mod_name file_path))
577 returnM (Right iface)
580 findHiFile :: ModuleName -> IsBootInterface
581 -> IO (Either [FilePath] FilePath)
582 findHiFile mod_name hi_boot_file
584 -- In interactive or --make mode, we are *not allowed* to demand-load
585 -- a home package .hi file. So don't even look for them.
586 -- This helps in the case where you are sitting in eg. ghc/lib/std
587 -- and start up GHCi - it won't complain that all the modules it tries
588 -- to load are found in the home location.
589 ghci_mode <- readIORef v_GhcMode ;
590 let { home_allowed = hi_boot_file ||
591 not (isCompManagerMode ghci_mode) } ;
592 maybe_found <- if home_allowed
593 then findModule mod_name
594 else findPackageModule mod_name ;
596 case maybe_found of {
597 Left files -> return (Left files) ;
599 Right (_, loc) -> do { -- Don't need module returned by finder
601 -- Return the path to M.hi, M.hi-boot, or M.hi-boot-n as appropriate
602 let { hi_path = ml_hi_file loc ;
603 hi_boot_path = replaceFilenameSuffix hi_path hiBootExt ;
604 hi_boot_ver_path = replaceFilenameSuffix hi_path hiBootVerExt
607 if not hi_boot_file then
608 return (Right hi_path)
610 hi_ver_exists <- doesFileExist hi_boot_ver_path ;
611 if hi_ver_exists then return (Right hi_boot_ver_path)
612 else return (Right hi_boot_path)
616 @readIface@ tries just the one file.
619 readIface :: ModuleName -> String -> IsBootInterface
620 -> IfM lcl (Either Message ModIface)
621 -- Left err <=> file not found, or unreadable, or illegible
622 -- Right iface <=> successfully found and parsed
624 readIface wanted_mod_name file_path is_hi_boot_file
625 = do { dflags <- getDOpts
626 ; ioToIOEnv (read_iface dflags wanted_mod_name file_path is_hi_boot_file) }
628 read_iface dflags wanted_mod file_path is_hi_boot_file
629 | is_hi_boot_file -- Read ascii
630 = do { res <- tryMost (hGetStringBuffer file_path) ;
632 Left exn -> return (Left (text (showException exn))) ;
634 case unP parseIface (mkPState buffer loc dflags) of
635 PFailed span err -> return (Left (mkLocMessage span err))
637 | wanted_mod == actual_mod -> return (Right iface)
638 | otherwise -> return (Left err)
640 actual_mod = moduleName (mi_module iface)
641 err = hiModuleNameMismatchWarn wanted_mod actual_mod
644 | otherwise -- Read binary
645 = do { res <- tryMost (readBinIface file_path)
647 Right iface -> return (Right iface)
648 Left exn -> return (Left (text (showException exn))) }
650 loc = mkSrcLoc (mkFastString file_path) 1 0
654 %*********************************************************
656 Wired-in interface for GHC.Prim
658 %*********************************************************
661 initExternalPackageState :: ExternalPackageState
662 initExternalPackageState
664 eps_is_boot = emptyModuleEnv,
665 eps_PIT = emptyPackageIfaceTable,
666 eps_PTE = emptyTypeEnv,
667 eps_inst_env = emptyInstEnv,
668 eps_rule_base = emptyRuleBase,
669 eps_insts = emptyNameEnv,
670 eps_rules = addRulesToPool [] (map mk_gated_rule builtinRules),
671 -- Initialise the EPS rule pool with the built-in rules
672 eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
673 , n_insts_in = 0, n_insts_out = 0
674 , n_rules_in = length builtinRules, n_rules_out = 0 }
677 mk_gated_rule (fn_name, core_rule)
678 = ([fn_name], (nameModuleName fn_name, IfaceBuiltinRule (mkIfaceExtName fn_name) core_rule))
682 %*********************************************************
684 Wired-in interface for GHC.Prim
686 %*********************************************************
689 ghcPrimIface :: ModIface
691 = (emptyModIface basePackage gHC_PRIM_Name) {
692 mi_exports = [(gHC_PRIM_Name, ghcPrimExports)],
694 mi_fixities = fixities,
695 mi_fix_fn = mkIfaceFixCache fixities
698 fixities = [(getOccName seqId, Fixity 0 InfixR)]
702 %*********************************************************
704 \subsection{Statistics}
706 %*********************************************************
709 ifaceStats :: ExternalPackageState -> SDoc
711 = hcat [text "Renamer stats: ", msg]
713 stats = eps_stats eps
715 [int (n_ifaces_in stats) <+> text "interfaces read",
716 hsep [ int (n_decls_out stats), text "type/class/variable imported, out of",
717 int (n_decls_in stats), text "read"],
718 hsep [ int (n_insts_out stats), text "instance decls imported, out of",
719 int (n_insts_in stats), text "read"],
720 hsep [ int (n_rules_out stats), text "rule decls imported, out of",
721 int (n_rules_in stats), text "read"]
726 %*********************************************************
730 %*********************************************************
733 badIfaceFile file err
734 = vcat [ptext SLIT("Bad interface file:") <+> text file,
737 hiModuleNameMismatchWarn :: ModuleName -> ModuleName -> Message
738 hiModuleNameMismatchWarn requested_mod read_mod =
739 hsep [ ptext SLIT("Something is amiss; requested module name")
741 , ptext SLIT("differs from name found in the interface file")
745 noIfaceErr dflags mod_name boot_file files
746 = ptext SLIT("Could not find interface file for") <+> quotes (ppr mod_name)
750 | verbosity dflags < 3 =
751 text "(use -v to see a list of the files searched for)"
753 hang (ptext SLIT("locations searched:")) 4 (vcat (map text files))
755 wrongIfaceModErr iface mod_name file_path
756 = sep [ptext SLIT("Interface file") <+> iface_file,
757 ptext SLIT("contains module") <+> quotes (ppr (mi_module iface)) <> comma,
758 ptext SLIT("but we were expecting module") <+> quotes (ppr mod_name),
759 sep [ptext SLIT("Probable cause: the source code which generated"),
761 ptext SLIT("has an incompatible module name")
764 where iface_file = doubleQuotes (text file_path)