2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[RnIfaces]{Cacheing and Renaming of Interfaces}
10 getSpecialInstModules, getDeferredDataDecls,
11 importDecl, recordSlurp,
12 getImportVersions, getSlurpedNames, getRnStats,
20 #include "HsVersions.h"
22 import CmdLineOpts ( opt_PruneTyDecls, opt_PruneInstDecls,
23 opt_D_show_rn_imports, opt_IgnoreIfacePragmas
25 import HsSyn ( HsDecl(..), TyDecl(..), ClassDecl(..), InstDecl(..), IfaceSig(..),
26 HsType(..), ConDecl(..), IE(..), ConDetails(..), Sig(..),
29 import BasicTypes ( Version, NewOrData(..), IfaceFlavour(..) )
30 import RdrHsSyn ( RdrNameHsDecl, RdrNameInstDecl, RdrNameTyDecl,
31 RdrName(..), rdrNameOcc
33 import RnEnv ( newImportedGlobalName, addImplicitOccsRn,
34 ifaceFlavour, availName, availNames, addAvailToNameSet
36 import RnSource ( rnHsSigType )
38 import RnHsSyn ( RenamedHsDecl )
39 import ParseIface ( parseIface, IfaceStuff(..) )
41 import FiniteMap ( FiniteMap, sizeFM, emptyFM, delFromFM,
42 lookupFM, addToFM, addToFM_C, addListToFM,
45 import Name ( Name {-instance NamedThing-}, Provenance, OccName(..),
46 nameModule, moduleString, pprModule, isLocallyDefined,
47 NameSet(..), emptyNameSet, unionNameSets, nameSetToList,
48 minusNameSet, mkNameSet, elemNameSet, nameUnique, addOneToNameSet,
49 isWiredInName, maybeWiredInTyConName, maybeWiredInIdName,
52 import Id ( GenId, Id(..), idType, dataConTyCon, isAlgCon )
53 import TyCon ( TyCon, tyConDataCons, isSynTyCon, getSynTyConDefn )
54 import Type ( namesOfType )
55 import TyVar ( GenTyVar )
56 import SrcLoc ( mkSrcLoc, SrcLoc )
57 import PrelMods ( pREL_GHC )
58 import PrelInfo ( cCallishTyKeys )
60 import Maybes ( MaybeErr(..), maybeToBool )
61 import ListSetOps ( unionLists )
63 import Unique ( Unique )
64 import StringBuffer ( StringBuffer, hGetStringBuffer )
65 import FastString ( mkFastString )
68 import IO ( isDoesNotExistError )
74 %*********************************************************
76 \subsection{Statistics}
78 %*********************************************************
81 getRnStats :: [RenamedHsDecl] -> RnMG SDoc
83 = getIfacesRn `thenRn` \ ifaces ->
85 Ifaces this_mod mod_map decls_fm all_names imp_names (unslurped_insts,_) deferred_data_decls inst_mods = ifaces
86 n_mods = sizeFM mod_map
88 decls_imported = filter is_imported_decl all_decls
89 decls_read = [decl | (name, (_, avail, decl)) <- fmToList decls_fm,
90 name == availName avail,
91 -- Data, newtype, and class decls are in the decls_fm
92 -- under multiple names; the tycon/class, and each
93 -- constructor/class op too.
94 not (isLocallyDefined name)
97 (cd_rd, dd_rd, add_rd, nd_rd, and_rd, sd_rd, vd_rd, _) = count_decls decls_read
98 (cd_sp, dd_sp, add_sp, nd_sp, and_sp, sd_sp, vd_sp, id_sp) = count_decls decls_imported
100 inst_decls_unslurped = length (bagToList unslurped_insts)
101 inst_decls_read = id_sp + inst_decls_unslurped
104 [int n_mods <> text " interfaces read",
105 hsep [int cd_sp, text "class decls imported, out of",
106 int cd_rd, text "read"],
107 hsep [int dd_sp, text "data decls imported (of which", int add_sp, text "abstractly), out of",
108 int dd_rd, text "read"],
109 hsep [int nd_sp, text "newtype decls imported (of which", int and_sp, text "abstractly), out of",
110 int nd_rd, text "read"],
111 hsep [int sd_sp, text "type synonym decls imported, out of",
112 int sd_rd, text "read"],
113 hsep [int vd_sp, text "value signatures imported, out of",
114 int vd_rd, text "read"],
115 hsep [int id_sp, text "instance decls imported, out of",
116 int inst_decls_read, text "read"]
119 returnRn (hcat [text "Renamer stats: ", stats])
121 is_imported_decl (DefD _) = False
122 is_imported_decl (ValD _) = False
123 is_imported_decl decl = not (isLocallyDefined (hsDeclName decl))
126 = -- pprTrace "count_decls" (ppr decls
131 -- ppr imported_decls
134 data_decls, abstract_data_decls,
135 newtype_decls, abstract_newtype_decls,
140 class_decls = length [() | ClD _ <- decls]
141 data_decls = length [() | TyD (TyData DataType _ _ _ _ _ _ _) <- decls]
142 newtype_decls = length [() | TyD (TyData NewType _ _ _ _ _ _ _) <- decls]
143 abstract_data_decls = length [() | TyD (TyData DataType _ _ _ [] _ _ _) <- decls]
144 abstract_newtype_decls = length [() | TyD (TyData NewType _ _ _ [] _ _ _) <- decls]
145 syn_decls = length [() | TyD (TySynonym _ _ _ _) <- decls]
146 val_decls = length [() | SigD _ <- decls]
147 inst_decls = length [() | InstD _ <- decls]
151 %*********************************************************
153 \subsection{Loading a new interface file}
155 %*********************************************************
158 loadInterface :: SDoc -> Module -> IfaceFlavour -> RnMG Ifaces
159 loadInterface doc_str load_mod as_source
160 = getIfacesRn `thenRn` \ ifaces ->
162 Ifaces this_mod mod_map decls
163 all_names imp_names (insts, tycls_names)
164 deferred_data_decls inst_mods = ifaces
166 -- CHECK WHETHER WE HAVE IT ALREADY
167 case lookupFM mod_map load_mod of {
168 Just (hif, _, _, _) | hif `as_good_as` as_source
169 -> -- Already in the cache; don't re-read it
173 -- READ THE MODULE IN
174 findAndReadIface doc_str load_mod as_source `thenRn` \ read_result ->
175 case read_result of {
176 -- Check for not found
177 Nothing -> -- Not found, so add an empty export env to the Ifaces map
178 -- so that we don't look again
180 new_mod_map = addToFM mod_map load_mod (HiFile, 0, [],[])
181 new_ifaces = Ifaces this_mod new_mod_map
182 decls all_names imp_names (insts, tycls_names)
183 deferred_data_decls inst_mods
185 setIfacesRn new_ifaces `thenRn_`
186 failWithRn new_ifaces (noIfaceErr load_mod) ;
189 Just (ParsedIface _ mod_vers usages exports rd_inst_mods fixs rd_decls rd_insts) ->
191 -- LOAD IT INTO Ifaces
192 -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
193 --- names is done correctly (notably, whether this is an .hi file or .hi-boot file).
194 -- If we do loadExport first the wrong info gets into the cache (unless we
195 -- explicitly tag each export which seems a bit of a bore)
196 foldlRn (loadDecl load_mod as_source) decls rd_decls `thenRn` \ new_decls ->
197 mapRn loadExport exports `thenRn` \ avails_s ->
198 foldlRn (loadInstDecl load_mod) insts rd_insts `thenRn` \ new_insts ->
200 mod_details = (as_source, mod_vers, concat avails_s, fixs)
202 -- Exclude this module from the "special-inst" modules
203 new_inst_mods = inst_mods `unionLists` (filter (/= this_mod) rd_inst_mods)
205 new_ifaces = Ifaces this_mod
206 (addToFM mod_map load_mod mod_details)
209 (new_insts, tycls_names)
213 setIfacesRn new_ifaces `thenRn_`
217 as_good_as HiFile any = True
218 as_good_as any HiBootFile = True
219 as_good_as _ _ = False
222 loadExport :: ExportItem -> RnMG [AvailInfo]
223 loadExport (mod, hif, entities)
224 = mapRn load_entity entities
226 new_name occ = newImportedGlobalName mod occ hif
228 load_entity (Avail occ)
229 = new_name occ `thenRn` \ name ->
230 returnRn (Avail name)
231 load_entity (AvailTC occ occs)
232 = new_name occ `thenRn` \ name ->
233 mapRn new_name occs `thenRn` \ names ->
234 returnRn (AvailTC name names)
239 -> (Version, RdrNameHsDecl)
241 loadDecl mod as_source decls_map (version, decl)
242 = getDeclBinders new_implicit_name decl `thenRn` \ avail ->
243 returnRn (addListToFM decls_map
244 [(name,(version,avail,decl')) | name <- availNames avail]
248 If a signature decl is being loaded and we're ignoring interface pragmas,
249 toss away unfolding information.
251 Also, if the signature is loaded from a module we're importing from source,
252 we do the same. This is to avoid situations when compiling a pair of mutually
253 recursive modules, peering at unfolding info in the interface file of the other,
254 e.g., you compile A, it looks at B's interface file and may as a result change
255 it's interface file. Hence, B is recompiled, maybe changing it's interface file,
256 which will the ufolding info used in A to become invalid. Simple way out is to
257 just ignore unfolding info.
261 SigD (IfaceSig name tp ls loc) | from_hi_boot || opt_IgnoreIfacePragmas ->
262 SigD (IfaceSig name tp [] loc)
265 new_implicit_name rdr_name loc = newImportedGlobalName mod (rdrNameOcc rdr_name) as_source
267 from_hi_boot = case as_source of
271 loadInstDecl :: Module
274 -> RnMG (Bag IfaceInst)
275 loadInstDecl mod_name insts decl@(InstDecl inst_ty binds uprags dfun_name src_loc)
277 -- Find out what type constructors and classes are "gates" for the
278 -- instance declaration. If all these "gates" are slurped in then
279 -- we should slurp the instance decl too.
281 -- We *don't* want to count names in the context part as gates, though.
283 -- instance Foo a => Baz (T a) where ...
285 -- Here the gates are Baz and T, but *not* Foo.
287 munged_inst_ty = case inst_ty of
288 HsForAllTy tvs cxt ty -> HsForAllTy tvs [] ty
289 HsPreForAllTy cxt ty -> HsPreForAllTy [] ty
292 -- We find the gates by renaming the instance type with in a
293 -- and returning the occurrence pool.
294 initRnMS emptyRnEnv mod_name vanillaInterfaceMode (
295 findOccurrencesRn (rnHsSigType (text "an instance decl") munged_inst_ty)
296 ) `thenRn` \ gate_names ->
297 returnRn (((mod_name, decl), gate_names) `consBag` insts)
299 vanillaInterfaceMode = InterfaceMode Compulsory (\_ -> False)
303 %********************************************************
305 \subsection{Loading usage information}
307 %********************************************************
310 checkUpToDate :: Module -> RnMG Bool -- True <=> no need to recompile
311 checkUpToDate mod_name
312 = findAndReadIface doc_str mod_name HiFile `thenRn` \ read_result ->
314 -- CHECK WHETHER WE HAVE IT ALREADY
316 Nothing -> -- Old interface file not found, so we'd better bail out
317 traceRn (sep [ptext SLIT("Didnt find old iface"),
318 pprModule mod_name]) `thenRn_`
321 Just (ParsedIface _ _ usages _ _ _ _ _)
322 -> -- Found it, so now check it
325 -- Only look in current directory, with suffix .hi
326 doc_str = sep [ptext SLIT("need usage info from"), pprModule mod_name]
328 checkModUsage [] = returnRn True -- Yes! Everything is up to date!
330 checkModUsage ((mod, hif, old_mod_vers, whats_imported) : rest)
331 = loadInterface doc_str mod hif `thenRn` \ ifaces ->
333 Ifaces _ mod_map decls _ _ _ _ _ = ifaces
334 maybe_new_mod_vers = lookupFM mod_map mod
335 Just (_, new_mod_vers, _, _) = maybe_new_mod_vers
337 -- If we can't find a version number for the old module then
338 -- bail out saying things aren't up to date
339 if not (maybeToBool maybe_new_mod_vers) then
340 traceRn (sep [ptext SLIT("Can't find version number for module"), pprModule mod]) `thenRn_`
344 -- If the module version hasn't changed, just move on
345 if new_mod_vers == old_mod_vers then
346 traceRn (sep [ptext SLIT("Module version unchanged:"), pprModule mod]) `thenRn_`
349 traceRn (sep [ptext SLIT("Module version has changed:"), pprModule mod]) `thenRn_`
351 -- Module version changed, so check entities inside
353 -- If the usage info wants to say "I imported everything from this module"
354 -- it does so by making whats_imported equal to Everything
355 -- In that case, we must recompile
356 case whats_imported of {
357 Everything -> traceRn (ptext SLIT("...and I needed the whole module")) `thenRn_`
358 returnRn False; -- Bale out
360 Specifically old_local_vers ->
362 -- Non-empty usage list, so check item by item
363 checkEntityUsage mod decls old_local_vers `thenRn` \ up_to_date ->
365 traceRn (ptext SLIT("...but the bits I use haven't.")) `thenRn_`
366 checkModUsage rest -- This one's ok, so check the rest
368 returnRn False -- This one failed, so just bail out now
371 doc_str = sep [ptext SLIT("need version info for"), pprModule mod]
374 checkEntityUsage mod decls []
375 = returnRn True -- Yes! All up to date!
377 checkEntityUsage mod decls ((occ_name,old_vers) : rest)
378 = newImportedGlobalName mod occ_name HiFile `thenRn` \ name ->
379 case lookupFM decls name of
381 Nothing -> -- We used it before, but it ain't there now
382 putDocRn (sep [ptext SLIT("No longer exported:"), ppr name]) `thenRn_`
385 Just (new_vers,_,_) -- It's there, but is it up to date?
386 | new_vers == old_vers
387 -- Up to date, so check the rest
388 -> checkEntityUsage mod decls rest
391 -- Out of date, so bale out
392 -> putDocRn (sep [ptext SLIT("Out of date:"), ppr name]) `thenRn_`
397 %*********************************************************
399 \subsection{Getting in a declaration}
401 %*********************************************************
404 importDecl :: Occurrence -> RnSMode -> RnMG (Maybe RdrNameHsDecl)
405 -- Returns Nothing for a wired-in or already-slurped decl
407 importDecl (name, loc) mode
408 = checkSlurped name `thenRn` \ already_slurped ->
409 if already_slurped then
410 -- traceRn (sep [text "Already slurped:", ppr name]) `thenRn_`
411 returnRn Nothing -- Already dealt with
413 if isWiredInName name then
414 getWiredInDecl name mode
416 getIfacesRn `thenRn` \ ifaces ->
418 Ifaces this_mod _ _ _ _ _ _ _ = ifaces
419 mod = nameModule name
421 if mod == this_mod then -- Don't bring in decls from
422 pprTrace "importDecl wierdness:" (ppr name) $
423 returnRn Nothing -- the renamed module's own interface file
426 getNonWiredInDecl name loc mode
430 getNonWiredInDecl :: Name -> SrcLoc -> RnSMode -> RnMG (Maybe RdrNameHsDecl)
431 getNonWiredInDecl needed_name loc mode
432 = traceRn doc_str `thenRn_`
433 loadInterface doc_str mod (ifaceFlavour needed_name) `thenRn` \ (Ifaces _ _ decls _ _ _ _ _) ->
434 case lookupFM decls needed_name of
436 -- Special case for data/newtype type declarations
437 Just (version, avail, TyD ty_decl) | is_data_or_newtype ty_decl
438 -> getNonWiredDataDecl needed_name version avail ty_decl `thenRn` \ (avail', maybe_decl) ->
439 recordSlurp (Just version) necessity avail' `thenRn_`
442 Just (version,avail,decl)
443 -> recordSlurp (Just version) necessity avail `thenRn_`
446 Nothing -> -- Can happen legitimately for "Optional" occurrences
448 Optional -> addWarnRn (getDeclWarn needed_name loc);
449 other -> addErrRn (getDeclErr needed_name loc)
453 necessity = modeToNecessity mode
454 doc_str = sep [ptext SLIT("need decl for"), ppr needed_name, ptext SLIT("needed at"), ppr loc]
455 mod = nameModule needed_name
457 is_data_or_newtype (TyData _ _ _ _ _ _ _ _) = True
458 is_data_or_newtype other = False
462 @getWiredInDecl@ maps a wired-in @Name@ to what it makes available.
463 It behaves exactly as if the wired in decl were actually in an interface file.
466 * if the wired-in name is a data type constructor or a data constructor,
467 it brings in the type constructor and all the data constructors; and
468 marks as "occurrences" any free vars of the data con.
470 * similarly for synonum type constructor
472 * if the wired-in name is another wired-in Id, it marks as "occurrences"
473 the free vars of the Id's type.
475 * it loads the interface file for the wired-in thing for the
476 sole purpose of making sure that its instance declarations are available
478 All this is necessary so that we know all types that are "in play", so
479 that we know just what instances to bring into scope.
482 getWiredInDecl name mode
483 = initRnMS emptyRnEnv mod_name new_mode
484 get_wired `thenRn` \ avail ->
485 recordSlurp Nothing necessity avail `thenRn_`
487 -- Force in the home module in case it has instance decls for
488 -- the thing we are interested in.
490 -- Mini hack 1: no point for non-tycons/class; and if we
491 -- do this we find PrelNum trying to import PackedString,
492 -- because PrelBase's .hi file mentions PackedString.unpackString
493 -- But PackedString.hi isn't built by that point!
495 -- Mini hack 2; GHC is guaranteed not to have
496 -- instance decls, so it's a waste of time to read it
498 -- NB: We *must* look at the availName of the slurped avail,
499 -- not the name passed to getWiredInDecl! Why? Because if a data constructor
500 -- or class op is passed to getWiredInDecl we'll pull in the whole data/class
501 -- decl, and recordSlurp will record that fact. But since the data constructor
502 -- isn't a tycon/class we won't force in the home module. And even if the
503 -- type constructor/class comes along later, loadDecl will say that it's already
504 -- been slurped, so getWiredInDecl won't even be called. Pretty obscure bug, this was.
506 main_name = availName avail
507 main_is_tc = case avail of { AvailTC _ _ -> True; Avail _ -> False }
508 mod = nameModule main_name
509 doc_str = sep [ptext SLIT("need home module for wired in thing"), ppr name]
511 (if not main_is_tc || mod == pREL_GHC then
514 loadInterface doc_str mod (ifaceFlavour main_name) `thenRn_`
518 returnRn Nothing -- No declaration to process further
520 necessity = modeToNecessity mode
521 new_mode = case mode of
522 InterfaceMode _ _ -> mode
523 SourceMode -> vanillaInterfaceMode
525 get_wired | is_tycon -- ... a type constructor
526 = get_wired_tycon the_tycon
528 | (isAlgCon the_id) -- ... a wired-in data constructor
529 = get_wired_tycon (dataConTyCon the_id)
531 | otherwise -- ... a wired-in non data-constructor
532 = get_wired_id the_id
534 mod_name = nameModule name
535 maybe_wired_in_tycon = maybeWiredInTyConName name
536 is_tycon = maybeToBool maybe_wired_in_tycon
537 maybe_wired_in_id = maybeWiredInIdName name
538 Just the_tycon = maybe_wired_in_tycon
539 Just the_id = maybe_wired_in_id
543 = addImplicitOccsRn id_mentions `thenRn_`
544 returnRn (Avail (getName id))
546 id_mentions = nameSetToList (namesOfType ty)
549 get_wired_tycon tycon
551 = addImplicitOccsRn (nameSetToList mentioned) `thenRn_`
552 returnRn (AvailTC tc_name [tc_name])
554 tc_name = getName tycon
555 (tyvars,ty) = getSynTyConDefn tycon
556 mentioned = namesOfType ty `minusNameSet` mkNameSet (map getName tyvars)
558 get_wired_tycon tycon
559 | otherwise -- data or newtype
560 = addImplicitOccsRn (nameSetToList mentioned) `thenRn_`
561 returnRn (AvailTC tycon_name (tycon_name : map getName data_cons))
563 tycon_name = getName tycon
564 data_cons = tyConDataCons tycon
565 mentioned = foldr (unionNameSets . namesOfType . idType) emptyNameSet data_cons
570 %*********************************************************
572 \subsection{Getting what a module exports}
574 %*********************************************************
577 getInterfaceExports :: Module -> IfaceFlavour -> RnMG (Avails, [(OccName,Fixity)])
578 getInterfaceExports mod as_source
579 = loadInterface doc_str mod as_source `thenRn` \ (Ifaces _ mod_map _ _ _ _ _ _) ->
580 case lookupFM mod_map mod of
581 Nothing -> -- Not there; it must be that the interface file wasn't found;
582 -- the error will have been reported already.
583 -- (Actually loadInterface should put the empty export env in there
584 -- anyway, but this does no harm.)
587 Just (_, _, avails, fixities) -> returnRn (avails, fixities)
589 doc_str = sep [pprModule mod, ptext SLIT("is directly imported")]
593 %*********************************************************
595 \subsection{Data type declarations are handled specially}
597 %*********************************************************
599 Data type declarations get special treatment. If we import a data type decl
600 with all its constructors, we end up importing all the types mentioned in
601 the constructors' signatures, and hence {\em their} data type decls, and so on.
602 In effect, we get the transitive closure of data type decls. Worse, this drags
603 in tons on instance decls, and their unfoldings, and so on.
605 If only the type constructor is mentioned, then all this is a waste of time.
606 If any of the data constructors are mentioned then we really have to
607 drag in the whole declaration.
609 So when we import the type constructor for a @data@ or @newtype@ decl, we
610 put it in the "deferred data/newtype decl" pile in Ifaces. Right at the end
611 we slurp these decls, if they havn't already been dragged in by an occurrence
615 getNonWiredDataDecl needed_name
617 avail@(AvailTC tycon_name _)
618 ty_decl@(TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc)
619 | needed_name == tycon_name
621 && not (nameUnique needed_name `elem` cCallishTyKeys)
622 -- Hack! Don't prune these tycons whose constructors
623 -- the desugarer must be able to see when desugaring
626 = -- Need the type constructor; so put it in the deferred set for now
627 getIfacesRn `thenRn` \ ifaces ->
629 Ifaces this_mod mod_map decls_fm slurped_names imp_names
630 unslurped_insts deferred_data_decls inst_mods = ifaces
632 new_ifaces = Ifaces this_mod mod_map decls_fm slurped_names imp_names
633 unslurped_insts new_deferred_data_decls inst_mods
635 no_constr_ty_decl = TyData new_or_data [] tycon tyvars [] derivings pragmas src_loc
636 new_deferred_data_decls = addToFM deferred_data_decls tycon_name no_constr_ty_decl
637 -- Nota bene: we nuke both the constructors and the context in the deferred decl.
638 -- If we don't nuke the context then renaming the deferred data decls can give
639 -- new unresolved names (for the classes). This could be handled, but there's
640 -- no point. If the data type is completely abstract then we aren't interested
643 setIfacesRn new_ifaces `thenRn_`
644 returnRn (AvailTC tycon_name [tycon_name], Nothing)
647 = -- Need a data constructor, so delete the data decl from the deferred set if it's there
648 getIfacesRn `thenRn` \ ifaces ->
650 Ifaces this_mod mod_map decls_fm slurped_names imp_names
651 unslurped_insts deferred_data_decls inst_mods = ifaces
653 new_ifaces = Ifaces this_mod mod_map decls_fm slurped_names imp_names
654 unslurped_insts new_deferred_data_decls inst_mods
656 new_deferred_data_decls = delFromFM deferred_data_decls tycon_name
658 setIfacesRn new_ifaces `thenRn_`
659 returnRn (avail, Just (TyD ty_decl))
663 getDeferredDataDecls :: RnMG [(Name, RdrNameTyDecl)]
665 = getIfacesRn `thenRn` \ (Ifaces _ _ _ _ _ _ deferred_data_decls _) ->
667 deferred_list = fmToList deferred_data_decls
668 trace_msg = hang (text "Slurping abstract data/newtype decls for: ")
669 4 (ppr (map fst deferred_list))
671 traceRn trace_msg `thenRn_`
672 returnRn deferred_list
676 %*********************************************************
678 \subsection{Instance declarations are handled specially}
680 %*********************************************************
683 getImportedInstDecls :: RnMG [(Module,RdrNameInstDecl)]
685 = -- First load any special-instance modules that aren't aready loaded
686 getSpecialInstModules `thenRn` \ inst_mods ->
687 mapRn load_it inst_mods `thenRn_`
689 -- Now we're ready to grab the instance declarations
690 -- Find the un-gated ones and return them,
691 -- removing them from the bag kept in Ifaces
692 getIfacesRn `thenRn` \ ifaces ->
694 Ifaces this_mod mod_map decls slurped_names imp_names (insts, tycls_names) deferred_data_decls inst_mods = ifaces
696 -- An instance decl is ungated if all its gates have been slurped
697 select_ungated :: IfaceInst -- A gated inst decl
699 -> ([(Module, RdrNameInstDecl)], [IfaceInst]) -- Accumulator
701 -> ([(Module, RdrNameInstDecl)], -- The ungated ones
702 [IfaceInst]) -- Still gated, but with
704 select_ungated (decl,gates) (ungated_decls, gated_decls)
705 | null remaining_gates
706 = (decl : ungated_decls, gated_decls)
708 = (ungated_decls, (decl, remaining_gates) : gated_decls)
710 remaining_gates = filter (not . (`elemNameSet` tycls_names)) gates
712 (un_gated_insts, still_gated_insts) = foldrBag select_ungated ([], []) insts
714 new_ifaces = Ifaces this_mod mod_map decls slurped_names imp_names
715 ((listToBag still_gated_insts), tycls_names)
716 -- NB: don't throw away tycls_names; we may comre across more instance decls
720 traceRn (sep [text "getInstDecls:", fsep (map ppr (nameSetToList tycls_names))]) `thenRn_`
721 setIfacesRn new_ifaces `thenRn_`
722 returnRn un_gated_insts
724 load_it mod = loadInterface (doc_str mod) mod HiFile
725 doc_str mod = sep [pprModule mod, ptext SLIT("is a special-instance module")]
728 getSpecialInstModules :: RnMG [Module]
729 getSpecialInstModules
730 = getIfacesRn `thenRn` \ ifaces ->
732 Ifaces _ _ _ _ _ _ _ inst_mods = ifaces
738 %*********************************************************
740 \subsection{Keeping track of what we've slurped, and version numbers}
742 %*********************************************************
744 getImportVersions figures out what the "usage information" for this moudule is;
745 that is, what it must record in its interface file as the things it uses.
747 - anything reachable from its body code
748 - any module exported with a "module Foo".
750 Why the latter? Because if Foo changes then this module's export list
751 will change, so we must recompile this module at least as far as
752 making a new interface file --- but in practice that means complete
756 module A( f, g ) where module B( f ) where
757 import B( f ) f = h 3
760 Should we record B.f in A's usages? In fact we don't. Certainly, if
761 anything about B.f changes than anyone who imports A should be recompiled;
762 they'll get an early exit if they don't use B.f. However, even if B.f
763 doesn't change at all, B.h may do so, and this change may not be reflected
764 in f's version number. So there are two things going on when compiling module A:
766 1. Are A.o and A.hi correct? Then we can bale out early.
767 2. Should modules that import A be recompiled?
769 For (1) it is slightly harmful to record B.f in A's usages, because a change in
770 B.f's version will provoke full recompilation of A, producing an identical A.o,
771 and A.hi differing only in its usage-version of B.f (which isn't used by any importer).
773 For (2), because of the tricky B.h question above, we ensure that A.hi is touched
774 (even if identical to its previous version) if A's recompilation was triggered by
775 an imported .hi file date change. Given that, there's no need to record B.f in
778 On the other hand, if A exports "module B" then we *do* count module B among
779 A's usages, because we must recompile A to ensure that A.hi changes appropriately.
782 getImportVersions :: Module -- Name of this module
783 -> Maybe [IE any] -- Export list for this module
784 -> RnMG (VersionInfo Name) -- Version info for these names
786 getImportVersions this_mod exports
787 = getIfacesRn `thenRn` \ ifaces ->
789 Ifaces _ mod_map _ _ imp_names _ _ _ = ifaces
791 -- mv_map groups together all the things imported from a particular module.
792 mv_map, mv_map_mod :: FiniteMap Module (WhatsImported Name)
794 mv_map_mod = foldl add_mod emptyFM export_mods
795 -- mv_map_mod records all the modules that have a "module M"
796 -- in this module's export list with an "Everything"
798 mv_map = foldl add_mv mv_map_mod imp_names
799 -- mv_map adds the version numbers of things exported individually
801 mk_version_info (mod, local_versions)
802 = case lookupFM mod_map mod of
803 Just (hif, version, _, _) -> (mod, hif, version, local_versions)
805 returnRn (map mk_version_info (fmToList mv_map))
807 export_mods = case exports of
809 Just es -> [mod | IEModuleContents mod <- es, mod /= this_mod]
811 add_mv mv_map v@(name, version)
812 = addToFM_C add_item mv_map mod (Specifically [v])
814 mod = nameModule name
816 add_item Everything _ = Everything
817 add_item (Specifically xs) _ = Specifically (v:xs)
819 add_mod mv_map mod = addToFM mv_map mod Everything
824 = getIfacesRn `thenRn` \ (Ifaces _ _ _ slurped_names _ _ _ _) ->
825 returnRn (name `elemNameSet` slurped_names)
827 getSlurpedNames :: RnMG NameSet
829 = getIfacesRn `thenRn` \ ifaces ->
831 Ifaces _ _ _ slurped_names _ _ _ _ = ifaces
833 returnRn slurped_names
835 recordSlurp maybe_version necessity avail
836 = {- traceRn (hsep [text "Record slurp:", pprAvail avail,
837 -- NB PprForDebug prints export flag, which is too
838 -- strict; it's a knot-tied thing in RnNames
839 case necessity of {Compulsory -> text "comp"; Optional -> text "opt" } ]) `thenRn_`
841 getIfacesRn `thenRn` \ ifaces ->
843 Ifaces this_mod mod_map decls slurped_names imp_names
844 (insts, tycls_names) deferred_data_decls inst_mods = ifaces
846 new_slurped_names = addAvailToNameSet slurped_names avail
848 new_imp_names = case maybe_version of
849 Just version -> (availName avail, version) : imp_names
852 -- Add to the names that will let in instance declarations;
853 -- but only (a) if it's a type/class
854 -- (b) if it's compulsory (unless the test flag opt_PruneInstDecls is off)
855 new_tycls_names = case avail of
856 AvailTC tc _ | not opt_PruneInstDecls ||
857 case necessity of {Optional -> False; Compulsory -> True }
858 -> tycls_names `addOneToNameSet` tc
859 otherwise -> tycls_names
861 new_ifaces = Ifaces this_mod mod_map decls
864 (insts, new_tycls_names)
868 setIfacesRn new_ifaces
872 %*********************************************************
874 \subsection{Getting binders out of a declaration}
876 %*********************************************************
878 @getDeclBinders@ returns the names for a @RdrNameHsDecl@.
879 It's used for both source code (from @availsFromDecl@) and interface files
882 It doesn't deal with source-code specific things: ValD, DefD. They
883 are handled by the sourc-code specific stuff in RnNames.
886 getDeclBinders :: (RdrName -> SrcLoc -> RnMG Name) -- New-name function
890 getDeclBinders new_name (TyD (TyData _ _ tycon _ condecls _ _ src_loc))
891 = new_name tycon src_loc `thenRn` \ tycon_name ->
892 getConFieldNames new_name condecls `thenRn` \ sub_names ->
893 returnRn (AvailTC tycon_name (tycon_name : nub sub_names))
894 -- The "nub" is because getConFieldNames can legitimately return duplicates,
895 -- when a record declaration has the same field in multiple constructors
897 getDeclBinders new_name (TyD (TySynonym tycon _ _ src_loc))
898 = new_name tycon src_loc `thenRn` \ tycon_name ->
899 returnRn (AvailTC tycon_name [tycon_name])
901 getDeclBinders new_name (ClD (ClassDecl _ cname _ sigs _ _ tname dname src_loc))
902 = new_name cname src_loc `thenRn` \ class_name ->
903 new_name dname src_loc `thenRn` \ datacon_name ->
904 new_name tname src_loc `thenRn` \ tycon_name ->
906 -- Record the names for the class ops
907 mapRn (getClassOpNames new_name) sigs `thenRn` \ sub_names ->
909 returnRn (AvailTC class_name (class_name : datacon_name : tycon_name : sub_names))
911 getDeclBinders new_name (SigD (IfaceSig var ty prags src_loc))
912 = new_name var src_loc `thenRn` \ var_name ->
913 returnRn (Avail var_name)
915 getDeclBinders new_name (DefD _) = returnRn NotAvailable
916 getDeclBinders new_name (InstD _) = returnRn NotAvailable
919 getConFieldNames new_name (ConDecl con _ (RecCon fielddecls) src_loc : rest)
920 = mapRn (\n -> new_name n src_loc) (con:fields) `thenRn` \ cfs ->
921 getConFieldNames new_name rest `thenRn` \ ns ->
924 fields = concat (map fst fielddecls)
926 getConFieldNames new_name (ConDecl con _ _ src_loc : rest)
927 = new_name con src_loc `thenRn` \ n ->
928 getConFieldNames new_name rest `thenRn` \ ns ->
931 getConFieldNames new_name [] = returnRn []
933 getClassOpNames new_name (ClassOpSig op _ _ src_loc) = new_name op src_loc
937 %*********************************************************
939 \subsection{Reading an interface file}
941 %*********************************************************
944 findAndReadIface :: SDoc -> Module
946 -> RnMG (Maybe ParsedIface)
947 -- Nothing <=> file not found, or unreadable, or illegible
948 -- Just x <=> successfully found and parsed
949 findAndReadIface doc_str mod_name as_source
950 = traceRn trace_msg `thenRn_`
951 getSearchPathRn `thenRn` \ dirs ->
954 trace_msg = sep [hsep [ptext SLIT("Reading"),
955 case as_source of { HiBootFile -> ptext SLIT("[boot]"); other -> empty},
956 ptext SLIT("interface for"),
957 ptext mod_name <> semi],
958 nest 4 (ptext SLIT("reason:") <+> doc_str)]
960 -- For import {-# SOURCE #-} Foo, "as_source" will be True
961 -- and we read Foo.hi-boot, not Foo.hi. This is used to break
962 -- loops among modules.
963 mod_suffix hi = case as_source of
964 HiBootFile -> ".hi-boot" -- Ignore `ways' for boot files.
967 try all_dirs [] = traceRn (ptext SLIT("...failed")) `thenRn_`
970 try all_dirs ((dir,hisuf):dirs)
971 = readIface file_path `thenRn` \ read_result ->
973 Nothing -> try all_dirs dirs
974 Just iface -> traceRn (ptext SLIT("...done")) `thenRn_`
975 returnRn (Just iface)
977 file_path = dir ++ '/' : moduleString mod_name ++ (mod_suffix hisuf)
980 @readIface@ tries just the one file.
983 readIface :: String -> RnMG (Maybe ParsedIface)
984 -- Nothing <=> file not found, or unreadable, or illegible
985 -- Just x <=> successfully found and parsed
987 = ioToRnMG (hGetStringBuffer file_path) `thenRn` \ read_result ->
990 case parseIface contents (mkSrcLoc (mkFastString file_path) 1) of
991 Failed err -> failWithRn Nothing err
992 Succeeded (PIface iface) ->
993 if opt_D_show_rn_imports then
994 putDocRn (hcat[ptext SLIT("Read "), text file_path]) `thenRn_`
995 returnRn (Just iface)
997 returnRn (Just iface)
1000 if isDoesNotExistError err then
1003 failWithRn Nothing (cannaeReadFile file_path err)
1006 mkSearchPath takes a string consisting of a colon-separated list
1007 of directories and corresponding suffixes, and turns it into a list
1008 of (directory, suffix) pairs. For example:
1011 mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
1012 = [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
1016 mkSearchPath :: Maybe String -> SearchPath
1017 mkSearchPath Nothing = [(".",".hi")]
1018 mkSearchPath (Just s)
1023 case span (/= '%') s of
1025 case span (/= ':') rs of
1026 (hisuf,_:rest) -> (dir,hisuf):go rest
1027 (hisuf,[]) -> [(dir,hisuf)]
1030 %*********************************************************
1034 %*********************************************************
1038 = hcat [ptext SLIT("Could not find valid interface file "),
1039 quotes (pprModule filename)]
1041 cannaeReadFile file err
1042 = hcat [ptext SLIT("Failed in reading file: "),
1044 ptext SLIT("; error="),
1048 = sep [ptext SLIT("Failed to find interface decl for"),
1049 quotes (ppr name), ptext SLIT("needed at"), ppr loc]
1051 getDeclWarn name loc
1052 = sep [ptext SLIT("Warning: failed to find (optional) interface decl for"),
1053 quotes (ppr name), ptext SLIT("desired at"), ppr loc]