2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section{Dealing with interface files}
8 readIface, loadInterface, loadHomeInterface,
14 #include "HsVersions.h"
16 import DriverState ( v_GhcMode, isCompManagerMode )
17 import DriverUtil ( splitFilename )
18 import CmdLineOpts ( opt_IgnoreIfacePragmas )
19 import Parser ( parseIface )
20 import HscTypes ( ModIface(..), emptyModIface,
21 ExternalPackageState(..),
22 VersionInfo(..), ImportedModuleInfo,
23 lookupIfaceByModName, RdrExportItem, WhatsImported(..),
24 ImportVersion, WhetherHasOrphans, IsBootInterface,
25 DeclsMap, GatedDecl, IfaceInsts, IfaceRules, mkIfaceDecls,
26 AvailInfo, GenAvailInfo(..), ParsedIface(..), IfaceDeprecs,
27 Avails, availNames, availName, Deprecations(..)
29 import HsSyn ( TyClDecl(..), InstDecl(..), RuleDecl(..), ConDecl(..),
30 hsTyVarNames, splitHsInstDeclTy, tyClDeclName, tyClDeclNames
32 import RdrHsSyn ( RdrNameTyClDecl, RdrNameInstDecl, RdrNameRuleDecl )
33 import RnHsSyn ( RenamedInstDecl, RenamedRuleDecl, RenamedTyClDecl,
35 import BasicTypes ( Version, FixitySig(..), Fixity(..), FixityDirection(..) )
36 import RnSource ( rnIfaceRuleDecl, rnTyClDecl, rnInstDecl )
37 import RnTypes ( rnHsType )
41 import PrelNames ( gHC_PRIM_Name, gHC_PRIM )
42 import PrelInfo ( ghcPrimExports, cCallableClassDecl, cReturnableClassDecl )
43 import Name ( Name {-instance NamedThing-},
44 nameModule, isInternalName )
49 import Packages ( preludePackage )
50 import Module ( Module, ModuleName, ModLocation(ml_hi_file),
51 moduleName, isHomeModule, mkVanillaModule,
54 import RdrName ( RdrName, mkRdrUnqual, rdrNameOcc, nameRdrName )
55 import OccName ( OccName, mkWorkerOcc, mkClassTyConOcc, mkClassDataConOcc,
56 mkSuperDictSelOcc, mkGenOcc1, mkGenOcc2 )
57 import TyCon ( DataConDetails(..) )
58 import SrcLoc ( noSrcLoc, mkSrcLoc )
59 import Maybes ( maybeToBool )
60 import StringBuffer ( hGetStringBuffer )
61 import FastString ( mkFastString )
62 import ErrUtils ( Message )
63 import Finder ( findModule, findPackageModule )
66 import ListSetOps ( minusList )
69 import BinIface ( readBinIface )
73 import EXCEPTION as Exception
74 import DATA_IOREF ( readIORef )
80 %*********************************************************
82 \subsection{Loading a new interface file}
84 %*********************************************************
87 loadHomeInterface :: SDoc -> Name -> TcRn m ModIface
88 loadHomeInterface doc_str name
89 = ASSERT2( not (isInternalName name), ppr name <+> parens doc_str )
90 loadInterface doc_str (moduleName (nameModule name)) ImportBySystem
92 loadOrphanModules :: [ModuleName] -> TcRn m ()
93 loadOrphanModules mods
94 | null mods = returnM ()
95 | otherwise = traceRn (text "Loading orphan modules:" <+>
96 fsep (map ppr mods)) `thenM_`
97 mappM_ load mods `thenM_`
100 load mod = loadInterface (mk_doc mod) mod ImportBySystem
101 mk_doc mod = ppr mod <+> ptext SLIT("is a orphan-instance module")
103 loadInterface :: SDoc -> ModuleName -> WhereFrom -> TcRn m ModIface
104 -- Returns Nothing if failed
105 -- If we can't find an interface file, and we are doing ImportForUsage,
106 -- just fail in the monad, and modify anything else
107 -- Otherwise, if we can't find an interface file,
108 -- add an error message to the monad (the first time only)
109 -- and return emptyIface
110 -- The "first time only" part is done by modifying the PackageIfaceTable
111 -- to have an empty entry
113 -- The ImportForUsage case is because when we read the usage information from
114 -- an interface file, we try to read the interfaces it mentions.
115 -- But it's OK to fail; perhaps the module has changed, and that interface
116 -- is no longer used.
118 -- tryLoadInterface guarantees to return with eps_mod_info m --> (..., True)
119 -- (If the load fails, we plug in a vanilla placeholder)
120 loadInterface doc_str mod_name from
121 = getHpt `thenM` \ hpt ->
122 getModule `thenM` \ this_mod ->
123 getEps `thenM` \ eps@(EPS { eps_PIT = pit }) ->
125 -- CHECK WHETHER WE HAVE IT ALREADY
126 case lookupIfaceByModName hpt pit mod_name of {
127 Just iface | case from of
128 ImportByUser src_imp -> src_imp == mi_boot iface
129 ImportForUsage src_imp -> src_imp == mi_boot iface
130 ImportBySystem -> True
131 -> returnM iface ; -- Already loaded
132 -- The not (mi_boot iface) test checks that the already-loaded
133 -- interface isn't a boot iface. This can conceivably happen,
134 -- if the version checking happened to load a boot interface
135 -- before we got to real imports.
139 mod_map = eps_imp_mods eps
140 mod_info = lookupFM mod_map mod_name
143 = case (from, mod_info) of
144 (ImportByUser is_boot, _) -> is_boot
145 (ImportForUsage is_boot, _) -> is_boot
146 (ImportBySystem, Just (_, is_boot)) -> is_boot
147 (ImportBySystem, Nothing) -> False
148 -- We're importing a module we know absolutely
149 -- nothing about, so we assume it's from
150 -- another package, where we aren't doing
151 -- dependency tracking. So it won't be a hi-boot file.
153 redundant_source_import
154 = case (from, mod_info) of
155 (ImportByUser True, Just (_,False)) -> True
159 -- Issue a warning for a redundant {- SOURCE -} import
160 -- NB that we arrange to read all the ordinary imports before
161 -- any of the {- SOURCE -} imports
162 warnIf redundant_source_import
163 (warnRedundantSourceImport mod_name) `thenM_`
165 -- Check that we aren't importing ourselves.
166 -- That only happens in Rename.checkOldIface,
167 -- which doesn't call loadInterface
169 (isHomeModule this_mod && moduleName this_mod == mod_name)
170 (warnSelfImport this_mod) `thenM_`
172 -- READ THE MODULE IN
173 findAndReadIface doc_str mod_name hi_boot_file
174 `thenM` \ read_result ->
175 case read_result of {
177 | case from of { ImportForUsage _ -> True ; other -> False }
178 -> failM -- Fail with no error messages
181 -> let -- Not found, so add an empty export env to
182 -- the EPS map so that we don't look again
183 fake_mod = mkVanillaModule mod_name
184 fake_iface = emptyModIface fake_mod
185 new_eps = eps { eps_PIT = extendModuleEnv pit fake_mod fake_iface }
187 setEps new_eps `thenM_`
188 addErr (elaborate err) `thenM_`
191 elaborate err = hang (ptext SLIT("Failed to load interface for") <+>
192 quotes (ppr mod_name) <> colon) 4 err
196 Right (mod, iface) ->
200 -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
201 --- names is done correctly (notably, whether this is an .hi file or .hi-boot file).
202 -- If we do loadExport first the wrong info gets into the cache (unless we
203 -- explicitly tag each export which seems a bit of a bore)
206 -- Sanity check. If we're system-importing a module we know nothing at all
207 -- about, it should be from a different package to this one
208 WARN( not (maybeToBool mod_info) &&
209 case from of { ImportBySystem -> True; other -> False } &&
213 initRn (InterfaceMode mod) $
214 -- Set the module, for use when looking up occurrences
215 -- of names in interface decls and rules
216 loadDecls mod (eps_decls eps) (pi_decls iface) `thenM` \ (decls_vers, new_decls) ->
217 loadRules mod (eps_rules eps) (pi_rules iface) `thenM` \ (rule_vers, new_rules) ->
218 loadInstDecls mod (eps_insts eps) (pi_insts iface) `thenM` \ new_insts ->
219 loadExports (pi_exports iface) `thenM` \ (export_vers, avails) ->
220 loadFixDecls (pi_fixity iface) `thenM` \ fix_env ->
221 loadDeprecs (pi_deprecs iface) `thenM` \ deprec_env ->
223 version = VersionInfo { vers_module = pi_vers iface,
224 vers_exports = export_vers,
225 vers_rules = rule_vers,
226 vers_decls = decls_vers }
228 -- Add to mod_map info about the things the imported module
229 -- depends on, extracted from its usage info
230 -- No point for system imports, for reasons that escape me...
231 usages = pi_usages iface
232 mod_map1 = case from of
233 ImportBySystem -> mod_map
234 other -> addModDeps mod is_loaded usages mod_map
235 -- Delete the module itself, which is now in the PIT
236 mod_map2 = delFromFM mod_map1 mod_name
238 -- mod_deps is a pruned version of usages that records only what
239 -- module imported, but nothing about versions.
240 -- This info is used when demand-linking the dependencies
241 mod_deps = [ (mod,orph,boot,NothingAtAll) | (mod,orph,boot,_) <- usages]
243 this_mod_name = moduleName this_mod
244 is_loaded m = m == this_mod_name
245 || maybeToBool (lookupIfaceByModName hpt pit m)
246 -- We treat the currently-being-compiled module as 'loaded' because
247 -- even though it isn't yet in the HIT or PIT; otherwise it gets
248 -- put into iImpModInfo, and then spat out into its own interface
249 -- file as a dependency
251 -- Now add info about this module to the PIT
252 has_orphans = pi_orphan iface
253 new_pit = extendModuleEnv pit mod mod_iface
254 mod_iface = ModIface { mi_module = mod, mi_package = pi_pkg iface,
255 mi_version = version,
256 mi_orphan = has_orphans, mi_boot = hi_boot_file,
258 mi_fixities = fix_env, mi_deprecs = deprec_env,
259 mi_usages = mod_deps, -- Used for demand-loading,
260 -- not for version info
261 mi_decls = panic "No mi_decls in PIT",
265 new_eps = eps { eps_PIT = new_pit,
266 eps_decls = new_decls,
267 eps_insts = new_insts,
268 eps_rules = new_rules,
269 eps_imp_mods = mod_map2 }
271 setEps new_eps `thenM_`
275 -----------------------------------------------------
276 -- Adding module dependencies from the
277 -- import decls in the interface file
278 -----------------------------------------------------
281 -> (ModuleName -> Bool) -- True for modules that are already loaded
283 -> ImportedModuleInfo -> ImportedModuleInfo
284 -- (addModDeps M ivs deps)
285 -- We are importing module M, and M.hi contains 'import' decls given by ivs
286 addModDeps mod is_loaded new_deps mod_deps
287 = foldr add mod_deps filtered_new_deps
289 -- Don't record dependencies when importing a module from another package
290 -- Except for its descendents which contain orphans,
291 -- and in that case, forget about the boot indicator
292 filtered_new_deps :: [(ModuleName, (WhetherHasOrphans, IsBootInterface))]
294 | isHomeModule mod = [ (imp_mod, (has_orphans, is_boot))
295 | (imp_mod, has_orphans, is_boot, _) <- new_deps,
296 not (is_loaded imp_mod)
298 | otherwise = [ (imp_mod, (True, False))
299 | (imp_mod, has_orphans, _, _) <- new_deps,
300 not (is_loaded imp_mod) && has_orphans
302 add (imp_mod, dep) deps = addToFM_C combine deps imp_mod dep
304 combine old@(old_has_orphans, old_is_boot) new@(new_has_orphans, new_is_boot)
305 | old_is_boot = new -- Record the best is_boot info
308 -----------------------------------------------------
309 -- Loading the export list
310 -----------------------------------------------------
312 loadExports :: (Version, [RdrExportItem]) -> TcRn m (Version, [(ModuleName,Avails)])
313 loadExports (vers, items)
314 = mappM loadExport items `thenM` \ avails_s ->
315 returnM (vers, avails_s)
318 loadExport :: RdrExportItem -> TcRn m (ModuleName, Avails)
319 loadExport (mod, entities)
320 = mappM (load_entity mod) entities `thenM` \ avails ->
321 returnM (mod, avails)
323 load_entity mod (Avail occ)
324 = newGlobalName mod occ `thenM` \ name ->
326 load_entity mod (AvailTC occ occs)
327 = newGlobalName mod occ `thenM` \ name ->
328 mappM (newGlobalName mod) occs `thenM` \ names ->
329 returnM (AvailTC name names)
332 -----------------------------------------------------
333 -- Loading type/class/value decls
334 -----------------------------------------------------
338 -> [(Version, RdrNameTyClDecl)]
339 -> TcRn m (NameEnv Version, DeclsMap)
340 loadDecls mod (decls_map, n_slurped) decls
341 = foldlM (loadDecl mod) (emptyNameEnv, decls_map) decls `thenM` \ (vers, decls_map') ->
342 returnM (vers, (decls_map', n_slurped))
344 loadDecl mod (version_map, decls_map) (version, decl)
345 = getTyClDeclBinders mod decl `thenM` \ avail ->
346 getSysBinders mod decl `thenM` \ sys_names ->
348 full_avail = case avail of
350 AvailTC n ns -> AvailTC n (sys_names ++ ns)
351 main_name = availName full_avail
352 new_decls_map = extendNameEnvList decls_map stuff
353 stuff = [ (name, (full_avail, name==main_name, (mod, decl)))
354 | name <- availNames full_avail]
356 new_version_map = extendNameEnv version_map main_name version
358 traceRn (text "Loading" <+> ppr full_avail) `thenM_`
359 returnM (new_version_map, new_decls_map)
364 getTyClDeclBinders :: Module -> RdrNameTyClDecl -> TcRn m AvailInfo
366 getTyClDeclBinders mod (IfaceSig {tcdName = var, tcdLoc = src_loc})
367 = newTopBinder mod var src_loc `thenM` \ var_name ->
368 returnM (Avail var_name)
370 getTyClDeclBinders mod tycl_decl
371 = mapM new (tyClDeclNames tycl_decl) `thenM` \ names@(main_name:_) ->
372 returnM (AvailTC main_name names)
374 new (nm,loc) = newTopBinder mod nm loc
376 --------------------------------
377 -- The "system names" are extra implicit names *bound* by the decl.
379 getSysBinders :: Module -> TyClDecl RdrName -> TcRn m [Name]
380 -- Similar to tyClDeclNames, but returns the "implicit"
381 -- or "system" names of the declaration. And it only works
382 -- on RdrNames, returning OccNames
384 getSysBinders mod (ClassDecl {tcdName = cname, tcdCtxt = cxt, tcdLoc = loc})
385 = sequenceM [new_sys_bndr mod n loc | n <- sys_occs]
387 -- C.f. TcClassDcl.tcClassDecl1
388 sys_occs = tc_occ : data_occ : dw_occ : sc_sel_occs
389 cls_occ = rdrNameOcc cname
390 data_occ = mkClassDataConOcc cls_occ
391 dw_occ = mkWorkerOcc data_occ
392 tc_occ = mkClassTyConOcc cls_occ
393 sc_sel_occs = [mkSuperDictSelOcc n cls_occ | n <- [1..length cxt]]
395 getSysBinders mod (TyData {tcdName = tc_name, tcdCons = DataCons cons,
396 tcdGeneric = Just want_generic, tcdLoc = loc})
397 -- The 'Just' is because this is an interface-file decl
398 -- so it will say whether to derive generic stuff for it or not
399 = sequenceM ([new_sys_bndr mod n loc | n <- gen_occs] ++
400 map con_sys_occ cons)
402 -- c.f. TcTyDecls.tcTyDecl
403 tc_occ = rdrNameOcc tc_name
404 gen_occs | want_generic = [mkGenOcc1 tc_occ, mkGenOcc2 tc_occ]
406 con_sys_occ (ConDecl name _ _ _ loc)
407 = new_sys_bndr mod (mkWorkerOcc (rdrNameOcc name)) loc
409 getSysBinders mod decl = returnM []
411 new_sys_bndr mod occ loc = newTopBinder mod (mkRdrUnqual occ) loc
414 -----------------------------------------------------
415 -- Loading fixity decls
416 -----------------------------------------------------
419 = mappM loadFixDecl decls `thenM` \ to_add ->
420 returnM (mkNameEnv to_add)
422 loadFixDecl (FixitySig rdr_name fixity loc)
423 = lookupGlobalOccRn rdr_name `thenM` \ name ->
424 returnM (name, FixitySig name fixity loc)
427 -----------------------------------------------------
428 -- Loading instance decls
429 -----------------------------------------------------
431 loadInstDecls :: Module -> IfaceInsts
434 loadInstDecls mod (insts, n_slurped) decls
435 = foldlM (loadInstDecl mod) insts decls `thenM` \ insts' ->
436 returnM (insts', n_slurped)
439 loadInstDecl mod insts decl@(InstDecl inst_ty _ _ _ _)
440 = -- Find out what type constructors and classes are "gates" for the
441 -- instance declaration. If all these "gates" are slurped in then
442 -- we should slurp the instance decl too.
444 -- We *don't* want to count names in the context part as gates, though.
446 -- instance Foo a => Baz (T a) where ...
448 -- Here the gates are Baz and T, but *not* Foo.
450 -- HOWEVER: functional dependencies make things more complicated
451 -- class C a b | a->b where ...
452 -- instance C Foo Baz where ...
453 -- Here, the gates are really only C and Foo, *not* Baz.
454 -- That is, if C and Foo are visible, even if Baz isn't, we must
457 -- Rather than take fundeps into account "properly", we just slurp
458 -- if C is visible and *any one* of the Names in the types
459 -- This is a slightly brutal approximation, but most instance decls
460 -- are regular H98 ones and it's perfect for them.
462 -- NOTICE that we rename the type before extracting its free
463 -- variables. The free-variable finder for a renamed HsType
464 -- does the Right Thing for built-in syntax like [] and (,).
465 rnHsType (text "In an interface instance decl") inst_ty `thenM` \ inst_ty' ->
467 (tvs,_,cls,tys) = splitHsInstDeclTy inst_ty'
468 free_tcs = nameSetToList (extractHsTyNames_s tys) `minusList` hsTyVarNames tvs
470 gate_fn vis_fn = vis_fn cls && (null free_tcs || any vis_fn free_tcs)
471 -- The 'vis_fn' returns True for visible names
472 -- Here is the implementation of HOWEVER above
473 -- (Note that we do let the inst decl in if it mentions
474 -- no tycons at all. Hence the null free_ty_names.)
476 traceRn ((text "Load instance for" <+> ppr inst_ty') $$ ppr free_tcs) `thenM_`
477 returnM ((gate_fn, (mod, decl)) `consBag` insts)
481 -----------------------------------------------------
483 -----------------------------------------------------
487 -> (Version, [RdrNameRuleDecl])
488 -> RnM (Version, IfaceRules)
489 loadRules mod (rule_bag, n_slurped) (version, rules)
490 | null rules || opt_IgnoreIfacePragmas
491 = returnM (version, (rule_bag, n_slurped))
493 = mappM (loadRule mod) rules `thenM` \ new_rules ->
494 returnM (version, (rule_bag `unionBags` listToBag new_rules, n_slurped))
496 loadRule :: Module -> RdrNameRuleDecl -> RnM (GatedDecl RdrNameRuleDecl)
497 -- "Gate" the rule simply by whether the rule variable is
498 -- needed. We can refine this later.
499 loadRule mod decl@(IfaceRule _ _ _ var _ _ src_loc)
500 = lookupGlobalOccRn var `thenM` \ var_name ->
501 returnM (\vis_fn -> vis_fn var_name, (mod, decl))
504 -----------------------------------------------------
505 -- Loading Deprecations
506 -----------------------------------------------------
508 loadDeprecs :: IfaceDeprecs -> RnM Deprecations
509 loadDeprecs Nothing = returnM NoDeprecs
510 loadDeprecs (Just (Left txt)) = returnM (DeprecAll txt)
511 loadDeprecs (Just (Right prs)) = foldlM loadDeprec emptyNameEnv prs `thenM` \ env ->
512 returnM (DeprecSome env)
513 loadDeprec deprec_env (n, txt)
514 = lookupGlobalOccRn n `thenM` \ name ->
515 traceRn (text "Loaded deprecation(s) for" <+> ppr name <> colon <+> ppr txt) `thenM_`
516 returnM (extendNameEnv deprec_env name (name,txt))
520 %********************************************************
522 Load the ParsedIface for the *current* module
523 into a ModIface; then it can be checked
526 %********************************************************
529 loadOldIface :: ParsedIface -> RnM ModIface
532 = loadHomeDecls (pi_decls iface) `thenM` \ (decls_vers, new_decls) ->
533 loadHomeRules (pi_rules iface) `thenM` \ (rule_vers, new_rules) ->
534 loadHomeInsts (pi_insts iface) `thenM` \ new_insts ->
535 mappM loadHomeUsage (pi_usages iface) `thenM` \ usages ->
536 loadExports (pi_exports iface) `thenM` \ (export_vers, avails) ->
537 loadFixDecls (pi_fixity iface) `thenM` \ fix_env ->
538 loadDeprecs (pi_deprecs iface) `thenM` \ deprec_env ->
540 getModeRn `thenM` \ (InterfaceMode mod) ->
541 -- Caller sets the module before the call; also needed
542 -- by the newGlobalName stuff in some of the loadHomeX calls
544 version = VersionInfo { vers_module = pi_vers iface,
545 vers_exports = export_vers,
546 vers_rules = rule_vers,
547 vers_decls = decls_vers }
549 decls = mkIfaceDecls new_decls new_rules new_insts
551 mod_iface = ModIface { mi_module = mod, mi_package = pi_pkg iface,
552 mi_version = version,
553 mi_exports = avails, mi_usages = usages,
554 mi_boot = False, mi_orphan = pi_orphan iface,
555 mi_fixities = fix_env, mi_deprecs = deprec_env,
564 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
565 -> RnM (NameEnv Version, [RenamedTyClDecl])
566 loadHomeDecls decls = foldlM loadHomeDecl (emptyNameEnv, []) decls
568 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
569 -> (Version, RdrNameTyClDecl)
570 -> RnM (NameEnv Version, [RenamedTyClDecl])
571 loadHomeDecl (version_map, decls) (version, decl)
572 = rnTyClDecl decl `thenM` \ decl' ->
573 returnM (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
576 loadHomeRules :: (Version, [RdrNameRuleDecl])
577 -> RnM (Version, [RenamedRuleDecl])
578 loadHomeRules (version, rules)
579 = mappM rnIfaceRuleDecl rules `thenM` \ rules' ->
580 returnM (version, rules')
583 loadHomeInsts :: [RdrNameInstDecl]
584 -> RnM [RenamedInstDecl]
585 loadHomeInsts insts = mappM rnInstDecl insts
588 loadHomeUsage :: ImportVersion OccName
589 -> TcRn m (ImportVersion Name)
590 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
591 = rn_imps whats_imported `thenM` \ whats_imported' ->
592 returnM (mod_name, orphans, is_boot, whats_imported')
594 rn_imps NothingAtAll = returnM NothingAtAll
595 rn_imps (Everything v) = returnM (Everything v)
596 rn_imps (Specifically mv ev items rv) = mappM rn_imp items `thenM` \ items' ->
597 returnM (Specifically mv ev items' rv)
598 rn_imp (occ,vers) = newGlobalName mod_name occ `thenM` \ name ->
603 %*********************************************************
605 \subsection{Reading an interface file}
607 %*********************************************************
610 findAndReadIface :: SDoc -> ModuleName
611 -> IsBootInterface -- True <=> Look for a .hi-boot file
612 -- False <=> Look for .hi file
613 -> TcRn m (Either Message (Module, ParsedIface))
614 -- Nothing <=> file not found, or unreadable, or illegible
615 -- Just x <=> successfully found and parsed
617 -- It *doesn't* add an error to the monad, because
618 -- sometimes it's ok to fail... see notes with loadInterface
620 findAndReadIface doc_str mod_name hi_boot_file
621 = traceRn trace_msg `thenM_`
623 -- Check for GHC.Prim, and return its static interface
624 if mod_name == gHC_PRIM_Name
625 then returnM (Right (gHC_PRIM, ghcPrimIface))
628 ioToTcRn (findHiFile mod_name hi_boot_file) `thenM` \ maybe_found ->
632 traceRn (ptext SLIT("...not found")) `thenM_`
633 returnM (Left (noIfaceErr mod_name hi_boot_file))
635 Just (wanted_mod, file_path) ->
636 traceRn (ptext SLIT("readIFace") <+> text file_path) `thenM_`
638 readIface wanted_mod file_path hi_boot_file `thenM` \ read_result ->
639 -- Catch exceptions here
642 Left exn -> returnM (Left (badIfaceFile file_path
643 (text (showException exn))))
645 Right iface -> returnM (Right (wanted_mod, iface))
648 trace_msg = sep [hsep [ptext SLIT("Reading"),
649 if hi_boot_file then ptext SLIT("[boot]") else empty,
650 ptext SLIT("interface for"),
651 ppr mod_name <> semi],
652 nest 4 (ptext SLIT("reason:") <+> doc_str)]
654 findHiFile :: ModuleName -> IsBootInterface -> IO (Maybe (Module, FilePath))
655 findHiFile mod_name hi_boot_file
657 -- In interactive or --make mode, we are *not allowed* to demand-load
658 -- a home package .hi file. So don't even look for them.
659 -- This helps in the case where you are sitting in eg. ghc/lib/std
660 -- and start up GHCi - it won't complain that all the modules it tries
661 -- to load are found in the home location.
662 ghci_mode <- readIORef v_GhcMode ;
663 let { home_allowed = hi_boot_file ||
664 not (isCompManagerMode ghci_mode) } ;
665 maybe_found <- if home_allowed
666 then findModule mod_name
667 else findPackageModule mod_name ;
669 case maybe_found of {
670 Nothing -> return Nothing ;
672 Just (mod,loc) -> do {
674 -- Return the path to M.hi, M.hi-boot, or M.hi-boot-n as appropriate
675 let { hi_path = ml_hi_file loc ;
676 (hi_base, _hi_suf) = splitFilename hi_path ;
677 hi_boot_path = hi_base ++ ".hi-boot" ;
678 hi_boot_ver_path = hi_base ++ ".hi-boot-" ++ cHscIfaceFileVersion } ;
680 if not hi_boot_file then
681 return (Just (mod, hi_path))
683 hi_ver_exists <- doesFileExist hi_boot_ver_path ;
684 if hi_ver_exists then return (Just (mod, hi_boot_ver_path))
685 else return (Just (mod, hi_boot_path))
689 @readIface@ tries just the one file.
692 readIface :: Module -> String -> IsBootInterface -> TcRn m (Either Exception ParsedIface)
693 -- Nothing <=> file not found, or unreadable, or illegible
694 -- Just x <=> successfully found and parsed
696 readIface mod file_path is_hi_boot_file
697 = ioToTcRn (tryMost (read_iface mod file_path is_hi_boot_file))
699 read_iface mod file_path is_hi_boot_file
700 | is_hi_boot_file -- Read ascii
701 = do { buffer <- hGetStringBuffer file_path ;
702 case parseIface buffer (mkPState loc exts) of
703 POk _ iface | wanted_mod_name == actual_mod_name
706 -> throwDyn (ProgramError (showSDoc err))
707 -- 'showSDoc' is a bit yukky
709 wanted_mod_name = moduleName mod
710 actual_mod_name = pi_mod iface
711 err = hiModuleNameMismatchWarn wanted_mod_name actual_mod_name
713 PFailed err -> throwDyn (ProgramError (showSDoc err))
716 | otherwise -- Read binary
717 = readBinIface file_path
720 exts = ExtFlags {glasgowExtsEF = True,
724 loc = mkSrcLoc (mkFastString file_path) 1
728 %*********************************************************
730 Wired-in interface for GHC.Prim
732 %*********************************************************
735 ghcPrimIface :: ParsedIface
736 ghcPrimIface = ParsedIface {
737 pi_mod = gHC_PRIM_Name,
738 pi_pkg = preludePackage,
742 pi_exports = (1, [(gHC_PRIM_Name, ghcPrimExports)]),
743 pi_decls = [(1,cCallableClassDecl),
744 (1,cReturnableClassDecl)],
745 pi_fixity = [FixitySig (nameRdrName (idName seqId))
746 (Fixity 0 InfixR) noSrcLoc],
754 %*********************************************************
758 %*********************************************************
761 noIfaceErr mod_name boot_file
762 = ptext SLIT("Could not find interface file for") <+> quotes (ppr mod_name)
763 -- We used to print the search path, but we can't do that
764 -- now, because it's hidden inside the finder.
765 -- Maybe the finder should expose more functions.
767 badIfaceFile file err
768 = vcat [ptext SLIT("Bad interface file:") <+> text file,
771 hiModuleNameMismatchWarn :: ModuleName -> ModuleName -> Message
772 hiModuleNameMismatchWarn requested_mod read_mod =
773 hsep [ ptext SLIT("Something is amiss; requested module name")
775 , ptext SLIT("differs from name found in the interface file")
779 warnRedundantSourceImport mod_name
780 = ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
781 <+> quotes (ppr mod_name)
784 = ptext SLIT("Importing my own interface: module") <+> ppr mod