2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section{Dealing with interface files}
8 findAndReadIface, loadInterface, loadHomeInterface,
9 tryLoadInterface, loadOrphanModules,
11 getDeclBinders, getDeclSysBinders,
12 removeContext -- removeContext probably belongs somewhere else
15 #include "HsVersions.h"
17 import CmdLineOpts ( opt_IgnoreIfacePragmas )
19 import HsSyn ( HsDecl(..), TyClDecl(..), InstDecl(..), IfaceSig(..),
20 HsType(..), ConDecl(..),
21 ForeignDecl(..), ForKind(..), isDynamicExtName,
22 FixitySig(..), RuleDecl(..),
25 import BasicTypes ( Version )
26 import RdrHsSyn ( RdrNameHsDecl, RdrNameInstDecl, RdrNameRuleDecl,
31 import ParseIface ( parseIface, IfaceStuff(..) )
33 import Name ( Name {-instance NamedThing-}, nameOccName,
36 mkNameEnv, elemNameEnv, extendNameEnv
38 import Module ( Module,
39 moduleName, isModuleInThisPackage,
40 ModuleName, WhereFrom(..),
41 extendModuleEnv, lookupModuleEnvByName,
43 import RdrName ( RdrName, rdrNameOcc )
45 import SrcLoc ( mkSrcLoc, SrcLoc )
46 import Maybes ( maybeToBool )
47 import StringBuffer ( hGetStringBuffer )
48 import FastString ( mkFastString )
49 import ErrUtils ( Message )
57 %*********************************************************
59 \subsection{Loading a new interface file}
61 %*********************************************************
64 loadHomeInterface :: SDoc -> Name -> RnM d Ifaces
65 loadHomeInterface doc_str name
66 = loadInterface doc_str (moduleName (nameModule name)) ImportBySystem
68 loadOrphanModules :: [ModuleName] -> RnM d ()
69 loadOrphanModules mods
70 | null mods = returnRn ()
71 | otherwise = traceRn (text "Loading orphan modules:" <+>
72 fsep (map ppr mods)) `thenRn_`
73 mapRn_ load mods `thenRn_`
76 load mod = loadInterface (mk_doc mod) mod ImportBySystem
77 mk_doc mod = ppr mod <+> ptext SLIT("is a orphan-instance module")
79 loadInterface :: SDoc -> ModuleName -> WhereFrom -> RnM d Ifaces
80 loadInterface doc mod from
81 = tryLoadInterface doc mod from `thenRn` \ (ifaces, maybe_err) ->
83 Nothing -> returnRn ifaces
84 Just err -> failWithRn ifaces err
86 tryLoadInterface :: SDoc -> ModuleName -> WhereFrom -> RnM d (Ifaces, Maybe Message)
87 -- Returns (Just err) if an error happened
88 -- Guarantees to return with iImpModInfo m --> (..., True)
89 -- (If the load fails, we plug in a vanilla placeholder)
90 tryLoadInterface doc_str mod_name from
91 = getHomeIfaceTableRn `thenRn` \ hit ->
92 getIfacesRn `thenRn` \ ifaces ->
94 -- Check whether we have it already in the home package
95 case lookupModuleEnvByName hit mod_name of {
96 Just _ -> returnRn (ifaces, Nothing) ; -- In the home package
100 mod_map = iImpModInfo ifaces
101 mod_info = lookupFM mod_map mod_name
104 = case (from, mod_info) of
105 (ImportByUser, _) -> False -- Not hi-boot
106 (ImportByUserSource, _) -> True -- hi-boot
107 (ImportBySystem, Just (_, is_boot, _)) -> is_boot --
108 (ImportBySystem, Nothing) -> False
109 -- We're importing a module we know absolutely
110 -- nothing about, so we assume it's from
111 -- another package, where we aren't doing
112 -- dependency tracking. So it won't be a hi-boot file.
114 redundant_source_import
115 = case (from, mod_info) of
116 (ImportByUserSource, Just (_,False,_)) -> True
119 -- CHECK WHETHER WE HAVE IT ALREADY
122 -> -- We're read it already so don't re-read it
123 returnRn (ifaces, Nothing) ;
127 -- Issue a warning for a redundant {- SOURCE -} import
128 -- NB that we arrange to read all the ordinary imports before
129 -- any of the {- SOURCE -} imports
130 warnCheckRn (not redundant_source_import)
131 (warnRedundantSourceImport mod_name) `thenRn_`
133 -- READ THE MODULE IN
134 findAndReadIface doc_str mod_name hi_boot_file `thenRn` \ read_result ->
135 case read_result of {
136 Left err -> -- Not found, so add an empty export env to the Ifaces map
137 -- so that we don't look again
139 new_mod_map = addToFM mod_map mod_name (False, False, True)
140 new_ifaces = ifaces { iImpModInfo = new_mod_map }
142 setIfacesRn new_ifaces `thenRn_`
143 returnRn (new_ifaces, Just err) ;
146 Right (mod, iface) ->
148 -- LOAD IT INTO Ifaces
150 -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
151 --- names is done correctly (notably, whether this is an .hi file or .hi-boot file).
152 -- If we do loadExport first the wrong info gets into the cache (unless we
153 -- explicitly tag each export which seems a bit of a bore)
156 -- Sanity check. If we're system-importing a module we know nothing at all
157 -- about, it should be from a different package to this one
158 WARN( not (maybeToBool mod_info) &&
159 case from of { ImportBySystem -> True; other -> False } &&
160 isModuleInThisPackage mod,
163 loadDecls mod (iDecls ifaces) (pi_decls iface) `thenRn` \ (decls_vers, new_decls) ->
164 loadRules mod (iRules ifaces) (pi_rules iface) `thenRn` \ (rule_vers, new_rules) ->
165 loadFixDecls mod_name (pi_fixity iface) `thenRn` \ fix_env ->
166 loadDeprecs mod (pi_deprecs iface) `thenRn` \ deprec_env ->
167 foldlRn (loadInstDecl mod) (iInsts ifaces) (pi_insts iface) `thenRn` \ new_insts ->
168 loadExports (pi_exports iface) `thenRn` \ (export_vers, avails) ->
170 version = VersionInfo { vers_module = pi_vers iface,
171 vers_exports = export_vers,
172 vers_rules = rule_vers,
173 vers_decls = decls_vers }
175 -- For an explicit user import, add to mod_map info about
176 -- the things the imported module depends on, extracted
177 -- from its usage info.
178 mod_map1 = case from of
179 ImportByUser -> addModDeps mod (pi_usages iface) mod_map
181 mod_map2 = addToFM mod_map1 mod_name (has_orphans, hi_boot_file, True)
183 -- Now add info about this module to the PIT
184 has_orphans = pi_orphan iface
185 new_pit = extendModuleEnv (iPIT ifaces) mod mod_iface
186 mod_iface = ModIface { mi_module = mod, mi_version = version,
187 mi_exports = avails, mi_orphan = has_orphans,
188 mi_fixities = fix_env, mi_deprecs = deprec_env,
189 mi_usages = [], -- Will be filled in later
190 mi_decls = panic "No mi_decls in PIT",
191 mi_globals = panic "No mi_globals in PIT"
194 new_ifaces = ifaces { iPIT = new_pit,
198 iImpModInfo = mod_map2 }
200 setIfacesRn new_ifaces `thenRn_`
201 returnRn (new_ifaces, Nothing)
204 -----------------------------------------------------
205 -- Adding module dependencies from the
206 -- import decls in the interface file
207 -----------------------------------------------------
209 addModDeps :: Module -> [ImportVersion a]
210 -> ImportedModuleInfo -> ImportedModuleInfo
211 -- (addModDeps M ivs deps)
212 -- We are importing module M, and M.hi contains 'import' decls given by ivs
213 addModDeps mod new_deps mod_deps
214 = foldr add mod_deps filtered_new_deps
216 -- Don't record dependencies when importing a module from another package
217 -- Except for its descendents which contain orphans,
218 -- and in that case, forget about the boot indicator
219 filtered_new_deps :: [(ModuleName, (WhetherHasOrphans, IsBootInterface, IsLoaded))]
221 | isModuleInThisPackage mod
222 = [ (imp_mod, (has_orphans, is_boot, False))
223 | (imp_mod, has_orphans, is_boot, _) <- new_deps
225 | otherwise = [ (imp_mod, (True, False, False))
226 | (imp_mod, has_orphans, _, _) <- new_deps,
229 add (imp_mod, dep) deps = addToFM_C combine deps imp_mod dep
231 combine old@(_, old_is_boot, old_is_loaded) new
232 | old_is_loaded || not old_is_boot = old -- Keep the old info if it's already loaded
233 -- or if it's a non-boot pending load
234 | otherwise = new -- Otherwise pick new info
237 -----------------------------------------------------
238 -- Loading the export list
239 -----------------------------------------------------
241 loadExports :: (Version, [ExportItem]) -> RnM d (Version, Avails)
242 loadExports (vers, items)
243 = getModuleRn `thenRn` \ this_mod ->
244 mapRn (loadExport this_mod) items `thenRn` \ avails_s ->
245 returnRn (vers, concat avails_s)
248 loadExport :: Module -> ExportItem -> RnM d [AvailInfo]
249 loadExport this_mod (mod, entities)
250 | mod == moduleName this_mod = returnRn []
251 -- If the module exports anything defined in this module, just ignore it.
252 -- Reason: otherwise it looks as if there are two local definition sites
253 -- for the thing, and an error gets reported. Easiest thing is just to
254 -- filter them out up front. This situation only arises if a module
255 -- imports itself, or another module that imported it. (Necessarily,
256 -- this invoves a loop.) Consequence: if you say
261 -- module B( AType ) where
262 -- import {-# SOURCE #-} A( AType )
264 -- then you'll get a 'B does not export AType' message. A bit bogus
265 -- but it's a bogus thing to do!
268 = mapRn (load_entity mod) entities
270 new_name mod occ = newGlobalName mod occ
272 load_entity mod (Avail occ)
273 = new_name mod occ `thenRn` \ name ->
274 returnRn (Avail name)
275 load_entity mod (AvailTC occ occs)
276 = new_name mod occ `thenRn` \ name ->
277 mapRn (new_name mod) occs `thenRn` \ names ->
278 returnRn (AvailTC name names)
281 -----------------------------------------------------
282 -- Loading type/class/value decls
283 -----------------------------------------------------
287 -> [(Version, RdrNameHsDecl)]
288 -> RnM d (NameEnv Version, DeclsMap)
289 loadDecls mod decls_map decls
290 = foldlRn (loadDecl mod) (emptyNameEnv, decls_map) decls
293 -> (NameEnv Version, DeclsMap)
294 -> (Version, RdrNameHsDecl)
295 -> RnM d (NameEnv Version, DeclsMap)
296 loadDecl mod (version_map, decls_map) (version, decl)
297 = getDeclBinders new_name decl `thenRn` \ maybe_avail ->
298 case maybe_avail of {
299 Nothing -> returnRn (version_map, decls_map); -- No bindings
302 getDeclSysBinders new_name decl `thenRn` \ sys_bndrs ->
304 full_avail = addSysAvails avail sys_bndrs
305 -- Add the sys-binders to avail. When we import the decl,
306 -- it's full_avail that will get added to the 'already-slurped' set (iSlurp)
307 -- If we miss out sys-binders, we'll read the decl multiple times!
309 main_name = availName avail
310 new_decls_map = foldl add_decl decls_map
311 [ (name, (full_avail, name==main_name, (mod, decl')))
312 | name <- availNames full_avail]
313 add_decl decls_map (name, stuff)
314 = WARN( name `elemNameEnv` decls_map, ppr name )
315 extendNameEnv decls_map name stuff
317 new_version_map = extendNameEnv version_map main_name version
319 returnRn (new_version_map, new_decls_map)
322 -- newTopBinder puts into the cache the binder with the
323 -- module information set correctly. When the decl is later renamed,
324 -- the binding site will thereby get the correct module.
325 -- There maybe occurrences that don't have the correct Module, but
326 -- by the typechecker will propagate the binding definition to all
327 -- the occurrences, so that doesn't matter
328 new_name rdr_name loc = newTopBinder mod rdr_name loc
331 If a signature decl is being loaded, and optIgnoreIfacePragmas is on,
332 we toss away unfolding information.
334 Also, if the signature is loaded from a module we're importing from source,
335 we do the same. This is to avoid situations when compiling a pair of mutually
336 recursive modules, peering at unfolding info in the interface file of the other,
337 e.g., you compile A, it looks at B's interface file and may as a result change
338 its interface file. Hence, B is recompiled, maybe changing its interface file,
339 which will the unfolding info used in A to become invalid. Simple way out is to
340 just ignore unfolding info.
342 [Jan 99: I junked the second test above. If we're importing from an hi-boot
343 file there isn't going to *be* any pragma info. Maybe the above comment
344 dates from a time where we picked up a .hi file first if it existed?]
347 SigD (IfaceSig name tp ls loc) | opt_IgnoreIfacePragmas
348 -> SigD (IfaceSig name tp [] loc)
351 -----------------------------------------------------
352 -- Loading fixity decls
353 -----------------------------------------------------
355 loadFixDecls mod_name decls
356 = mapRn (loadFixDecl mod_name) decls `thenRn` \ to_add ->
357 returnRn (mkNameEnv to_add)
359 loadFixDecl mod_name sig@(FixitySig rdr_name fixity loc)
360 = newGlobalName mod_name (rdrNameOcc rdr_name) `thenRn` \ name ->
361 returnRn (name, fixity)
364 -----------------------------------------------------
365 -- Loading instance decls
366 -----------------------------------------------------
368 loadInstDecl :: Module
372 loadInstDecl mod insts decl@(InstDecl inst_ty binds uprags dfun_name src_loc)
374 -- Find out what type constructors and classes are "gates" for the
375 -- instance declaration. If all these "gates" are slurped in then
376 -- we should slurp the instance decl too.
378 -- We *don't* want to count names in the context part as gates, though.
380 -- instance Foo a => Baz (T a) where ...
382 -- Here the gates are Baz and T, but *not* Foo.
384 munged_inst_ty = removeContext inst_ty
385 free_names = extractHsTyRdrNames munged_inst_ty
388 mapRn lookupOrigName free_names `thenRn` \ gate_names ->
389 returnRn ((mkNameSet gate_names, (mod, InstD decl)) `consBag` insts)
392 -- In interface files, the instance decls now look like
393 -- forall a. Foo a -> Baz (T a)
394 -- so we have to strip off function argument types as well
395 -- as the bit before the '=>' (which is always empty in interface files)
396 removeContext (HsForAllTy tvs cxt ty) = HsForAllTy tvs [] (removeFuns ty)
397 removeContext ty = removeFuns ty
399 removeFuns (HsFunTy _ ty) = removeFuns ty
403 -----------------------------------------------------
405 -----------------------------------------------------
407 loadRules :: Module -> IfaceRules
408 -> (Version, [RdrNameRuleDecl])
409 -> RnM d (Version, IfaceRules)
410 loadRules mod rule_bag (version, rules)
411 | null rules || opt_IgnoreIfacePragmas
412 = returnRn (version, rule_bag)
415 mapRn (loadRule mod) rules `thenRn` \ new_rules ->
416 returnRn (version, rule_bag `unionBags` listToBag new_rules)
418 loadRule :: Module -> RdrNameRuleDecl -> RnM d GatedDecl
419 -- "Gate" the rule simply by whether the rule variable is
420 -- needed. We can refine this later.
421 loadRule mod decl@(IfaceRule _ _ var _ _ src_loc)
422 = lookupOrigName var `thenRn` \ var_name ->
423 returnRn (unitNameSet var_name, (mod, RuleD decl))
426 -----------------------------------------------------
427 -- Loading Deprecations
428 -----------------------------------------------------
430 loadDeprecs :: Module -> IfaceDeprecs -> RnM d Deprecations
431 loadDeprecs m Nothing = returnRn NoDeprecs
432 loadDeprecs m (Just (Left txt)) = returnRn (DeprecAll txt)
433 loadDeprecs m (Just (Right prs)) = setModuleRn m $
434 foldlRn loadDeprec emptyNameEnv prs `thenRn` \ env ->
435 returnRn (DeprecSome env)
436 loadDeprec deprec_env (n, txt)
437 = lookupOrigName n `thenRn` \ name ->
438 traceRn (text "Loaded deprecation(s) for" <+> ppr name <> colon <+> ppr txt) `thenRn_`
439 returnRn (extendNameEnv deprec_env name txt)
443 %*********************************************************
445 \subsection{Getting binders out of a declaration}
447 %*********************************************************
449 @getDeclBinders@ returns the names for a @RdrNameHsDecl@.
450 It's used for both source code (from @availsFromDecl@) and interface files
453 It doesn't deal with source-code specific things: @ValD@, @DefD@. They
454 are handled by the sourc-code specific stuff in @RnNames@.
457 getDeclBinders :: (RdrName -> SrcLoc -> RnM d Name) -- New-name function
459 -> RnM d (Maybe AvailInfo)
461 getDeclBinders new_name (TyClD tycl_decl)
462 = mapRn do_one (tyClDeclNames tycl_decl) `thenRn` \ (main_name:sub_names) ->
463 returnRn (Just (AvailTC main_name (main_name : sub_names)))
465 do_one (name,loc) = new_name name loc
467 getDeclBinders new_name (SigD (IfaceSig var ty prags src_loc))
468 = new_name var src_loc `thenRn` \ var_name ->
469 returnRn (Just (Avail var_name))
471 -- foreign declarations
472 getDeclBinders new_name (ForD (ForeignDecl nm kind _ dyn _ loc))
473 | binds_haskell_name kind dyn
474 = new_name nm loc `thenRn` \ name ->
475 returnRn (Just (Avail name))
477 | otherwise -- a foreign export
478 = lookupOrigName nm `thenRn_`
481 getDeclBinders new_name (FixD _) = returnRn Nothing
482 getDeclBinders new_name (DeprecD _) = returnRn Nothing
483 getDeclBinders new_name (DefD _) = returnRn Nothing
484 getDeclBinders new_name (InstD _) = returnRn Nothing
485 getDeclBinders new_name (RuleD _) = returnRn Nothing
487 binds_haskell_name (FoImport _) _ = True
488 binds_haskell_name FoLabel _ = True
489 binds_haskell_name FoExport ext_nm = isDynamicExtName ext_nm
492 @getDeclSysBinders@ gets the implicit binders introduced by a decl.
493 A the moment that's just the tycon and datacon that come with a class decl.
494 They aren't returned by @getDeclBinders@ because they aren't in scope;
495 but they {\em should} be put into the @DeclsMap@ of this module.
497 Note that this excludes the default-method names of a class decl,
498 and the dict fun of an instance decl, because both of these have
499 bindings of their own elsewhere.
502 getDeclSysBinders new_name (TyClD (ClassDecl _ cname _ _ sigs _ names src_loc))
503 = sequenceRn [new_name n src_loc | n <- names]
505 getDeclSysBinders new_name (TyClD (TyData _ _ _ _ cons _ _ _ _ _))
506 = sequenceRn [new_name wkr_name src_loc | ConDecl _ wkr_name _ _ _ src_loc <- cons]
508 getDeclSysBinders new_name other_decl
513 %*********************************************************
515 \subsection{Reading an interface file}
517 %*********************************************************
520 findAndReadIface :: SDoc -> ModuleName
521 -> IsBootInterface -- True <=> Look for a .hi-boot file
522 -- False <=> Look for .hi file
523 -> RnM d (Either Message (Module, ParsedIface))
524 -- Nothing <=> file not found, or unreadable, or illegible
525 -- Just x <=> successfully found and parsed
527 findAndReadIface doc_str mod_name hi_boot_file
528 = traceRn trace_msg `thenRn_`
529 -- we keep two maps for interface files,
530 -- one for 'normal' ones, the other for .hi-boot files,
531 -- hence the need to signal which kind we're interested.
533 getFinderRn `thenRn` \ finder ->
534 ioToRnM (finder mod_name) `thenRn` \ maybe_found ->
537 Right (Just (mod,locn))
538 | hi_boot_file -> readIface mod (hi_file locn ++ "-hi-boot")
539 | otherwise -> readIface mod (hi_file locn)
542 other -> traceRn (ptext SLIT("...not found")) `thenRn_`
543 returnRn (Left (noIfaceErr mod_name hi_boot_file))
546 trace_msg = sep [hsep [ptext SLIT("Reading"),
547 if hi_boot_file then ptext SLIT("[boot]") else empty,
548 ptext SLIT("interface for"),
549 ppr mod_name <> semi],
550 nest 4 (ptext SLIT("reason:") <+> doc_str)]
553 @readIface@ tries just the one file.
556 readIface :: Module -> String -> RnM d (Either Message (Module, ParsedIface))
557 -- Nothing <=> file not found, or unreadable, or illegible
558 -- Just x <=> successfully found and parsed
559 readIface wanted_mod file_path
560 = traceRn (ptext SLIT("...reading from") <+> text file_path) `thenRn_`
561 ioToRnM (hGetStringBuffer False file_path) `thenRn` \ read_result ->
564 case parseIface contents
565 PState{ bol = 0#, atbol = 1#,
568 loc = mkSrcLoc (mkFastString file_path) 1 } of
569 POk _ (PIface iface) ->
570 warnCheckRn (wanted_mod == read_mod)
571 (hiModuleNameMismatchWarn wanted_mod read_mod) `thenRn_`
572 returnRn (Right (wanted_mod, iface))
574 read_mod = pi_mod iface
576 PFailed err -> bale_out err
577 parse_result -> bale_out empty
578 -- This last case can happen if the interface file is (say) empty
579 -- in which case the parser thinks it looks like an IdInfo or
580 -- something like that. Just an artefact of the fact that the
581 -- parser is used for several purposes at once.
583 Left io_err -> bale_out (text (show io_err))
585 bale_out err = returnRn (Left (badIfaceFile file_path err))
589 %*********************************************************
593 %*********************************************************
596 noIfaceErr mod_name boot_file
597 = ptext SLIT("Could not find interface file for") <+> quotes (ppr mod_name)
598 -- We used to print the search path, but we can't do that
599 -- now, because it's hidden inside the finder.
600 -- Maybe the finder should expose more functions.
602 badIfaceFile file err
603 = vcat [ptext SLIT("Bad interface file:") <+> text file,
606 hiModuleNameMismatchWarn :: Module -> Module -> Message
607 hiModuleNameMismatchWarn requested_mod read_mod =
608 hsep [ ptext SLIT("Something is amiss; requested module name")
609 , ppr (moduleName requested_mod)
610 , ptext SLIT("differs from name found in the interface file")
614 warnRedundantSourceImport mod_name
615 = ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
616 <+> quotes (ppr mod_name)