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_IgnoreIfacePragmas
25 import HsSyn ( HsDecl(..), TyDecl(..), ClassDecl(..), InstDecl(..), IfaceSig(..),
26 HsType(..), ConDecl(..), IE(..), ConDetails(..), Sig(..),
29 import HsPragmas ( noGenPragmas )
30 import BasicTypes ( Version, NewOrData(..), IfaceFlavour(..) )
31 import RdrHsSyn ( RdrNameHsDecl, RdrNameInstDecl, RdrNameTyDecl,
32 RdrName(..), rdrNameOcc
34 import RnEnv ( newImportedGlobalName, addImplicitOccsRn, ifaceFlavour,
35 availName, availNames, addAvailToNameSet, pprAvail
37 import RnSource ( rnHsSigType )
39 import RnHsSyn ( RenamedHsDecl )
40 import ParseIface ( parseIface, IfaceStuff(..) )
42 import FiniteMap ( FiniteMap, sizeFM, emptyFM, unitFM, delFromFM,
43 lookupFM, addToFM, addToFM_C, addListToFM,
46 import Name ( Name {-instance NamedThing-}, Provenance, OccName(..),
47 nameModule, occNameString, moduleString, pprModule, isLocallyDefined,
48 NameSet(..), emptyNameSet, unionNameSets, nameSetToList,
49 minusNameSet, mkNameSet, elemNameSet, nameUnique, addOneToNameSet,
50 isWiredInName, maybeWiredInTyConName, maybeWiredInIdName,
53 import Id ( GenId, Id(..), idType, dataConTyCon, isAlgCon )
54 import TyCon ( TyCon, tyConDataCons, isSynTyCon, getSynTyConDefn )
55 import Type ( namesOfType )
56 import TyVar ( GenTyVar )
57 import SrcLoc ( mkSrcLoc, SrcLoc )
58 import PrelMods ( pREL_GHC )
59 import PrelInfo ( cCallishTyKeys )
61 import Maybes ( MaybeErr(..), expectJust, maybeToBool )
62 import ListSetOps ( unionLists )
64 import Unique ( Unique )
65 import StringBuffer ( StringBuffer, hGetStringBuffer, freeStringBuffer )
66 import FastString ( mkFastString )
69 import IO ( isDoesNotExistError )
75 %*********************************************************
77 \subsection{Statistics}
79 %*********************************************************
82 getRnStats :: [RenamedHsDecl] -> RnMG SDoc
84 = getIfacesRn `thenRn` \ ifaces ->
86 Ifaces this_mod mod_map decls_fm all_names imp_names (unslurped_insts,_) deferred_data_decls inst_mods = ifaces
87 n_mods = sizeFM mod_map
89 decls_imported = filter is_imported_decl all_decls
90 decls_read = [decl | (name, (_, avail, decl)) <- fmToList decls_fm,
91 name == availName avail,
92 -- Data, newtype, and class decls are in the decls_fm
93 -- under multiple names; the tycon/class, and each
94 -- constructor/class op too.
95 not (isLocallyDefined name)
98 (cd_rd, dd_rd, add_rd, nd_rd, and_rd, sd_rd, vd_rd, _) = count_decls decls_read
99 (cd_sp, dd_sp, add_sp, nd_sp, and_sp, sd_sp, vd_sp, id_sp) = count_decls decls_imported
101 inst_decls_unslurped = length (bagToList unslurped_insts)
102 inst_decls_read = id_sp + inst_decls_unslurped
105 [int n_mods <> text " interfaces read",
106 hsep [int cd_sp, text "class decls imported, out of",
107 int cd_rd, text "read"],
108 hsep [int dd_sp, text "data decls imported (of which", int add_sp, text "abstractly), out of",
109 int dd_rd, text "read"],
110 hsep [int nd_sp, text "newtype decls imported (of which", int and_sp, text "abstractly), out of",
111 int nd_rd, text "read"],
112 hsep [int sd_sp, text "type synonym decls imported, out of",
113 int sd_rd, text "read"],
114 hsep [int vd_sp, text "value signatures imported, out of",
115 int vd_rd, text "read"],
116 hsep [int id_sp, text "instance decls imported, out of",
117 int inst_decls_read, text "read"]
120 returnRn (hcat [text "Renamer stats: ", stats])
122 is_imported_decl (DefD _) = False
123 is_imported_decl (ValD _) = False
124 is_imported_decl decl = not (isLocallyDefined (hsDeclName decl))
127 = -- pprTrace "count_decls" (ppr decls
132 -- ppr imported_decls
135 data_decls, abstract_data_decls,
136 newtype_decls, abstract_newtype_decls,
141 class_decls = length [() | ClD _ <- decls]
142 data_decls = length [() | TyD (TyData DataType _ _ _ _ _ _ _) <- decls]
143 newtype_decls = length [() | TyD (TyData NewType _ _ _ _ _ _ _) <- decls]
144 abstract_data_decls = length [() | TyD (TyData DataType _ _ _ [] _ _ _) <- decls]
145 abstract_newtype_decls = length [() | TyD (TyData NewType _ _ _ [] _ _ _) <- decls]
146 syn_decls = length [() | TyD (TySynonym _ _ _ _) <- decls]
147 val_decls = length [() | SigD _ <- decls]
148 inst_decls = length [() | InstD _ <- decls]
152 %*********************************************************
154 \subsection{Loading a new interface file}
156 %*********************************************************
159 loadInterface :: SDoc -> Module -> IfaceFlavour -> RnMG Ifaces
160 loadInterface doc_str load_mod as_source
161 = getIfacesRn `thenRn` \ ifaces ->
163 Ifaces this_mod mod_map decls
164 all_names imp_names (insts, tycls_names)
165 deferred_data_decls inst_mods = ifaces
167 -- CHECK WHETHER WE HAVE IT ALREADY
168 case lookupFM mod_map load_mod of {
169 Just (hif, _, _, _) | hif `as_good_as` as_source
170 -> -- Already in the cache; don't re-read it
174 -- READ THE MODULE IN
175 findAndReadIface doc_str load_mod as_source `thenRn` \ read_result ->
176 case read_result of {
177 -- Check for not found
178 Nothing -> -- Not found, so add an empty export env to the Ifaces map
179 -- so that we don't look again
181 new_mod_map = addToFM mod_map load_mod (HiFile, 0, [],[])
182 new_ifaces = Ifaces this_mod new_mod_map
183 decls all_names imp_names (insts, tycls_names)
184 deferred_data_decls inst_mods
186 setIfacesRn new_ifaces `thenRn_`
187 failWithRn new_ifaces (noIfaceErr load_mod) ;
190 Just (ParsedIface _ mod_vers usages exports rd_inst_mods fixs rd_decls rd_insts) ->
192 -- LOAD IT INTO Ifaces
193 -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
194 --- names is done correctly (notably, whether this is an .hi file or .hi-boot file).
195 -- If we do loadExport first the wrong info gets into the cache (unless we
196 -- explicitly tag each export which seems a bit of a bore)
197 foldlRn (loadDecl load_mod as_source) decls rd_decls `thenRn` \ new_decls ->
198 mapRn loadExport exports `thenRn` \ avails_s ->
199 foldlRn (loadInstDecl load_mod) insts rd_insts `thenRn` \ new_insts ->
201 mod_details = (as_source, mod_vers, concat avails_s, fixs)
203 -- Exclude this module from the "special-inst" modules
204 new_inst_mods = inst_mods `unionLists` (filter (/= this_mod) rd_inst_mods)
206 new_ifaces = Ifaces this_mod
207 (addToFM mod_map load_mod mod_details)
210 (new_insts, tycls_names)
214 setIfacesRn new_ifaces `thenRn_`
218 as_good_as HiFile any = True
219 as_good_as any HiBootFile = True
220 as_good_as _ _ = False
223 loadExport :: ExportItem -> RnMG [AvailInfo]
224 loadExport (mod, hif, entities)
225 = mapRn load_entity entities
227 new_name occ = newImportedGlobalName mod occ hif
229 load_entity (Avail occ)
230 = new_name occ `thenRn` \ name ->
231 returnRn (Avail name)
232 load_entity (AvailTC occ occs)
233 = new_name occ `thenRn` \ name ->
234 mapRn new_name occs `thenRn` \ names ->
235 returnRn (AvailTC name names)
240 -> (Version, RdrNameHsDecl)
242 loadDecl mod as_source decls_map (version, decl)
243 = getDeclBinders new_implicit_name decl `thenRn` \ avail ->
244 returnRn (addListToFM decls_map
245 [(name,(version,avail,decl')) | name <- availNames avail]
249 If a signature decl is being loaded and we're ignoring interface pragmas,
250 toss away unfolding information.
252 Also, if the signature is loaded from a module we're importing from source,
253 we do the same. This is to avoid situations when compiling a pair of mutually
254 recursive modules, peering at unfolding info in the interface file of the other,
255 e.g., you compile A, it looks at B's interface file and may as a result change
256 it's interface file. Hence, B is recompiled, maybe changing it's interface file,
257 which will the ufolding info used in A to become invalid. Simple way out is to
258 just ignore unfolding info.
262 SigD (IfaceSig name tp ls loc) | from_hi_boot || opt_IgnoreIfacePragmas ->
263 SigD (IfaceSig name tp [] loc)
266 new_implicit_name rdr_name loc = newImportedGlobalName mod (rdrNameOcc rdr_name) as_source
268 from_hi_boot = case as_source of
272 loadInstDecl :: Module
275 -> RnMG (Bag IfaceInst)
276 loadInstDecl mod_name insts decl@(InstDecl inst_ty binds uprags dfun_name src_loc)
278 -- Find out what type constructors and classes are "gates" for the
279 -- instance declaration. If all these "gates" are slurped in then
280 -- we should slurp the instance decl too.
282 -- We *don't* want to count names in the context part as gates, though.
284 -- instance Foo a => Baz (T a) where ...
286 -- Here the gates are Baz and T, but *not* Foo.
288 munged_inst_ty = case inst_ty of
289 HsForAllTy tvs cxt ty -> HsForAllTy tvs [] ty
290 HsPreForAllTy cxt ty -> HsPreForAllTy [] ty
293 -- We find the gates by renaming the instance type with in a
294 -- and returning the occurrence pool.
295 initRnMS emptyRnEnv mod_name vanillaInterfaceMode (
296 findOccurrencesRn (rnHsSigType (text "an instance decl") munged_inst_ty)
297 ) `thenRn` \ gate_names ->
298 returnRn (((mod_name, decl), gate_names) `consBag` insts)
300 vanillaInterfaceMode = InterfaceMode Compulsory (\_ -> False)
304 %********************************************************
306 \subsection{Loading usage information}
308 %********************************************************
311 checkUpToDate :: Module -> RnMG Bool -- True <=> no need to recompile
312 checkUpToDate mod_name
313 = findAndReadIface doc_str mod_name HiFile `thenRn` \ read_result ->
315 -- CHECK WHETHER WE HAVE IT ALREADY
317 Nothing -> -- Old interface file not found, so we'd better bail out
318 traceRn (sep [ptext SLIT("Didnt find old iface"),
319 pprModule mod_name]) `thenRn_`
322 Just (ParsedIface _ _ usages _ _ _ _ _)
323 -> -- Found it, so now check it
326 -- Only look in current directory, with suffix .hi
327 doc_str = sep [ptext SLIT("need usage info from"), pprModule mod_name]
329 checkModUsage [] = returnRn True -- Yes! Everything is up to date!
331 checkModUsage ((mod, hif, old_mod_vers, whats_imported) : rest)
332 = loadInterface doc_str mod hif `thenRn` \ ifaces ->
334 Ifaces _ mod_map decls _ _ _ _ _ = ifaces
335 maybe_new_mod_vers = lookupFM mod_map mod
336 Just (_, new_mod_vers, _, _) = maybe_new_mod_vers
338 -- If we can't find a version number for the old module then
339 -- bail out saying things aren't up to date
340 if not (maybeToBool maybe_new_mod_vers) then
341 traceRn (sep [ptext SLIT("Can't find version number for module"), pprModule mod]) `thenRn_`
345 -- If the module version hasn't changed, just move on
346 if new_mod_vers == old_mod_vers then
347 traceRn (sep [ptext SLIT("Module version unchanged:"), pprModule mod]) `thenRn_`
350 traceRn (sep [ptext SLIT("Module version has changed:"), pprModule mod]) `thenRn_`
352 -- Module version changed, so check entities inside
354 -- If the usage info wants to say "I imported everything from this module"
355 -- it does so by making whats_imported equal to Everything
356 -- In that case, we must recompile
357 case whats_imported of {
358 Everything -> traceRn (ptext SLIT("...and I needed the whole module")) `thenRn_`
359 returnRn False; -- Bale out
361 Specifically old_local_vers ->
363 -- Non-empty usage list, so check item by item
364 checkEntityUsage mod decls old_local_vers `thenRn` \ up_to_date ->
366 traceRn (ptext SLIT("...but the bits I use haven't.")) `thenRn_`
367 checkModUsage rest -- This one's ok, so check the rest
369 returnRn False -- This one failed, so just bail out now
372 doc_str = sep [ptext SLIT("need version info for"), pprModule mod]
375 checkEntityUsage mod decls []
376 = returnRn True -- Yes! All up to date!
378 checkEntityUsage mod decls ((occ_name,old_vers) : rest)
379 = newImportedGlobalName mod occ_name HiFile `thenRn` \ name ->
380 case lookupFM decls name of
382 Nothing -> -- We used it before, but it ain't there now
383 putDocRn (sep [ptext SLIT("No longer exported:"), ppr name]) `thenRn_`
386 Just (new_vers,_,_) -- It's there, but is it up to date?
387 | new_vers == old_vers
388 -- Up to date, so check the rest
389 -> checkEntityUsage mod decls rest
392 -- Out of date, so bale out
393 -> putDocRn (sep [ptext SLIT("Out of date:"), ppr name]) `thenRn_`
398 %*********************************************************
400 \subsection{Getting in a declaration}
402 %*********************************************************
405 importDecl :: Occurrence -> RnSMode -> RnMG (Maybe RdrNameHsDecl)
406 -- Returns Nothing for a wired-in or already-slurped decl
408 importDecl (name, loc) mode
409 = checkSlurped name `thenRn` \ already_slurped ->
410 if already_slurped then
411 -- traceRn (sep [text "Already slurped:", ppr name]) `thenRn_`
412 returnRn Nothing -- Already dealt with
414 if isWiredInName name then
415 getWiredInDecl name mode
417 getIfacesRn `thenRn` \ ifaces ->
419 Ifaces this_mod _ _ _ _ _ _ _ = ifaces
420 mod = nameModule name
422 if mod == this_mod then -- Don't bring in decls from
423 pprTrace "importDecl wierdness:" (ppr name) $
424 returnRn Nothing -- the renamed module's own interface file
427 getNonWiredInDecl name loc mode
431 getNonWiredInDecl :: Name -> SrcLoc -> RnSMode -> RnMG (Maybe RdrNameHsDecl)
432 getNonWiredInDecl needed_name loc mode
433 = traceRn doc_str `thenRn_`
434 loadInterface doc_str mod (ifaceFlavour needed_name) `thenRn` \ (Ifaces _ _ decls _ _ _ _ _) ->
435 case lookupFM decls needed_name of
437 -- Special case for data/newtype type declarations
438 Just (version, avail, TyD ty_decl) | is_data_or_newtype ty_decl
439 -> getNonWiredDataDecl needed_name version avail ty_decl `thenRn` \ (avail', maybe_decl) ->
440 recordSlurp (Just version) necessity avail' `thenRn_`
443 Just (version,avail,decl)
444 -> recordSlurp (Just version) necessity avail `thenRn_`
447 Nothing -> -- Can happen legitimately for "Optional" occurrences
449 Optional -> addWarnRn (getDeclWarn needed_name loc);
450 other -> addErrRn (getDeclErr needed_name loc)
454 necessity = modeToNecessity mode
455 doc_str = sep [ptext SLIT("need decl for"), ppr needed_name, ptext SLIT("needed at"), ppr loc]
456 mod = nameModule needed_name
458 is_data_or_newtype (TyData _ _ _ _ _ _ _ _) = True
459 is_data_or_newtype other = False
463 @getWiredInDecl@ maps a wired-in @Name@ to what it makes available.
464 It behaves exactly as if the wired in decl were actually in an interface file.
467 * if the wired-in name is a data type constructor or a data constructor,
468 it brings in the type constructor and all the data constructors; and
469 marks as "occurrences" any free vars of the data con.
471 * similarly for synonum type constructor
473 * if the wired-in name is another wired-in Id, it marks as "occurrences"
474 the free vars of the Id's type.
476 * it loads the interface file for the wired-in thing for the
477 sole purpose of making sure that its instance declarations are available
479 All this is necessary so that we know all types that are "in play", so
480 that we know just what instances to bring into scope.
483 getWiredInDecl name mode
484 = initRnMS emptyRnEnv mod_name new_mode
485 get_wired `thenRn` \ avail ->
486 recordSlurp Nothing necessity avail `thenRn_`
488 -- Force in the home module in case it has instance decls for
489 -- the thing we are interested in.
491 -- Mini hack 1: no point for non-tycons/class; and if we
492 -- do this we find PrelNum trying to import PackedString,
493 -- because PrelBase's .hi file mentions PackedString.unpackString
494 -- But PackedString.hi isn't built by that point!
496 -- Mini hack 2; GHC is guaranteed not to have
497 -- instance decls, so it's a waste of time to read it
499 -- NB: We *must* look at the availName of the slurped avail,
500 -- not the name passed to getWiredInDecl! Why? Because if a data constructor
501 -- or class op is passed to getWiredInDecl we'll pull in the whole data/class
502 -- decl, and recordSlurp will record that fact. But since the data constructor
503 -- isn't a tycon/class we won't force in the home module. And even if the
504 -- type constructor/class comes along later, loadDecl will say that it's already
505 -- been slurped, so getWiredInDecl won't even be called. Pretty obscure bug, this was.
507 main_name = availName avail
508 main_is_tc = case avail of { AvailTC _ _ -> True; Avail _ -> False }
509 mod = nameModule main_name
510 doc_str = sep [ptext SLIT("need home module for wired in thing"), ppr name]
512 (if not main_is_tc || mod == pREL_GHC then
515 loadInterface doc_str mod (ifaceFlavour main_name) `thenRn_`
519 returnRn Nothing -- No declaration to process further
521 necessity = modeToNecessity mode
522 new_mode = case mode of
523 InterfaceMode _ _ -> mode
524 SourceMode -> vanillaInterfaceMode
526 get_wired | is_tycon -- ... a type constructor
527 = get_wired_tycon the_tycon
529 | (isAlgCon the_id) -- ... a wired-in data constructor
530 = get_wired_tycon (dataConTyCon the_id)
532 | otherwise -- ... a wired-in non data-constructor
533 = get_wired_id the_id
535 mod_name = nameModule name
536 maybe_wired_in_tycon = maybeWiredInTyConName name
537 is_tycon = maybeToBool maybe_wired_in_tycon
538 maybe_wired_in_id = maybeWiredInIdName name
539 Just the_tycon = maybe_wired_in_tycon
540 Just the_id = maybe_wired_in_id
544 = addImplicitOccsRn id_mentions `thenRn_`
545 returnRn (Avail (getName id))
547 id_mentions = nameSetToList (namesOfType ty)
550 get_wired_tycon tycon
552 = addImplicitOccsRn (nameSetToList mentioned) `thenRn_`
553 returnRn (AvailTC tc_name [tc_name])
555 tc_name = getName tycon
556 (tyvars,ty) = getSynTyConDefn tycon
557 mentioned = namesOfType ty `minusNameSet` mkNameSet (map getName tyvars)
559 get_wired_tycon tycon
560 | otherwise -- data or newtype
561 = addImplicitOccsRn (nameSetToList mentioned) `thenRn_`
562 returnRn (AvailTC tycon_name (tycon_name : map getName data_cons))
564 tycon_name = getName tycon
565 data_cons = tyConDataCons tycon
566 mentioned = foldr (unionNameSets . namesOfType . idType) emptyNameSet data_cons
571 %*********************************************************
573 \subsection{Getting what a module exports}
575 %*********************************************************
578 getInterfaceExports :: Module -> IfaceFlavour -> RnMG (Avails, [(OccName,Fixity)])
579 getInterfaceExports mod as_source
580 = loadInterface doc_str mod as_source `thenRn` \ (Ifaces _ mod_map _ _ _ _ _ _) ->
581 case lookupFM mod_map mod of
582 Nothing -> -- Not there; it must be that the interface file wasn't found;
583 -- the error will have been reported already.
584 -- (Actually loadInterface should put the empty export env in there
585 -- anyway, but this does no harm.)
588 Just (_, _, avails, fixities) -> returnRn (avails, fixities)
590 doc_str = sep [pprModule mod, ptext SLIT("is directly imported")]
594 %*********************************************************
596 \subsection{Data type declarations are handled specially}
598 %*********************************************************
600 Data type declarations get special treatment. If we import a data type decl
601 with all its constructors, we end up importing all the types mentioned in
602 the constructors' signatures, and hence {\em their} data type decls, and so on.
603 In effect, we get the transitive closure of data type decls. Worse, this drags
604 in tons on instance decls, and their unfoldings, and so on.
606 If only the type constructor is mentioned, then all this is a waste of time.
607 If any of the data constructors are mentioned then we really have to
608 drag in the whole declaration.
610 So when we import the type constructor for a @data@ or @newtype@ decl, we
611 put it in the "deferred data/newtype decl" pile in Ifaces. Right at the end
612 we slurp these decls, if they havn't already been dragged in by an occurrence
616 getNonWiredDataDecl needed_name
618 avail@(AvailTC tycon_name _)
619 ty_decl@(TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc)
620 | needed_name == tycon_name
622 && not (nameUnique needed_name `elem` cCallishTyKeys)
623 -- Hack! Don't prune these tycons whose constructors
624 -- the desugarer must be able to see when desugaring
627 = -- Need the type constructor; so put it in the deferred set for now
628 getIfacesRn `thenRn` \ ifaces ->
630 Ifaces this_mod mod_map decls_fm slurped_names imp_names
631 unslurped_insts deferred_data_decls inst_mods = ifaces
633 new_ifaces = Ifaces this_mod mod_map decls_fm slurped_names imp_names
634 unslurped_insts new_deferred_data_decls inst_mods
636 no_constr_ty_decl = TyData new_or_data [] tycon tyvars [] derivings pragmas src_loc
637 new_deferred_data_decls = addToFM deferred_data_decls tycon_name no_constr_ty_decl
638 -- Nota bene: we nuke both the constructors and the context in the deferred decl.
639 -- If we don't nuke the context then renaming the deferred data decls can give
640 -- new unresolved names (for the classes). This could be handled, but there's
641 -- no point. If the data type is completely abstract then we aren't interested
644 setIfacesRn new_ifaces `thenRn_`
645 returnRn (AvailTC tycon_name [tycon_name], Nothing)
648 = -- Need a data constructor, so delete the data decl from the deferred set if it's there
649 getIfacesRn `thenRn` \ ifaces ->
651 Ifaces this_mod mod_map decls_fm slurped_names imp_names
652 unslurped_insts deferred_data_decls inst_mods = ifaces
654 new_ifaces = Ifaces this_mod mod_map decls_fm slurped_names imp_names
655 unslurped_insts new_deferred_data_decls inst_mods
657 new_deferred_data_decls = delFromFM deferred_data_decls tycon_name
659 setIfacesRn new_ifaces `thenRn_`
660 returnRn (avail, Just (TyD ty_decl))
664 getDeferredDataDecls :: RnMG [(Name, RdrNameTyDecl)]
666 = getIfacesRn `thenRn` \ (Ifaces _ _ _ _ _ _ deferred_data_decls _) ->
668 deferred_list = fmToList deferred_data_decls
669 trace_msg = hang (text "Slurping abstract data/newtype decls for: ")
670 4 (ppr (map fst deferred_list))
672 traceRn trace_msg `thenRn_`
673 returnRn deferred_list
677 %*********************************************************
679 \subsection{Instance declarations are handled specially}
681 %*********************************************************
684 getImportedInstDecls :: RnMG [(Module,RdrNameInstDecl)]
686 = -- First load any special-instance modules that aren't aready loaded
687 getSpecialInstModules `thenRn` \ inst_mods ->
688 mapRn load_it inst_mods `thenRn_`
690 -- Now we're ready to grab the instance declarations
691 -- Find the un-gated ones and return them,
692 -- removing them from the bag kept in Ifaces
693 getIfacesRn `thenRn` \ ifaces ->
695 Ifaces this_mod mod_map decls slurped_names imp_names (insts, tycls_names) deferred_data_decls inst_mods = ifaces
697 -- An instance decl is ungated if all its gates have been slurped
698 select_ungated :: IfaceInst -- A gated inst decl
700 -> ([(Module, RdrNameInstDecl)], [IfaceInst]) -- Accumulator
702 -> ([(Module, RdrNameInstDecl)], -- The ungated ones
703 [IfaceInst]) -- Still gated, but with
705 select_ungated (decl,gates) (ungated_decls, gated_decls)
706 | null remaining_gates
707 = (decl : ungated_decls, gated_decls)
709 = (ungated_decls, (decl, remaining_gates) : gated_decls)
711 remaining_gates = filter (not . (`elemNameSet` tycls_names)) gates
713 (un_gated_insts, still_gated_insts) = foldrBag select_ungated ([], []) insts
715 new_ifaces = Ifaces this_mod mod_map decls slurped_names imp_names
716 ((listToBag still_gated_insts), tycls_names)
717 -- NB: don't throw away tycls_names; we may comre across more instance decls
721 traceRn (sep [text "getInstDecls:", fsep (map ppr (nameSetToList tycls_names))]) `thenRn_`
722 setIfacesRn new_ifaces `thenRn_`
723 returnRn un_gated_insts
725 load_it mod = loadInterface (doc_str mod) mod HiFile
726 doc_str mod = sep [pprModule mod, ptext SLIT("is a special-instance module")]
729 getSpecialInstModules :: RnMG [Module]
730 getSpecialInstModules
731 = getIfacesRn `thenRn` \ ifaces ->
733 Ifaces _ _ _ _ _ _ _ inst_mods = ifaces
739 %*********************************************************
741 \subsection{Keeping track of what we've slurped, and version numbers}
743 %*********************************************************
745 getImportVersions figures out what the "usage information" for this moudule is;
746 that is, what it must record in its interface file as the things it uses.
748 - anything reachable from its body code
749 - any module exported with a "module Foo".
751 Why the latter? Because if Foo changes then this module's export list
752 will change, so we must recompile this module at least as far as
753 making a new interface file --- but in practice that means complete
757 module A( f, g ) where module B( f ) where
758 import B( f ) f = h 3
761 Should we record B.f in A's usages? In fact we don't. Certainly, if
762 anything about B.f changes than anyone who imports A should be recompiled;
763 they'll get an early exit if they don't use B.f. However, even if B.f
764 doesn't change at all, B.h may do so, and this change may not be reflected
765 in f's version number. So there are two things going on when compiling module A:
767 1. Are A.o and A.hi correct? Then we can bale out early.
768 2. Should modules that import A be recompiled?
770 For (1) it is slightly harmful to record B.f in A's usages, because a change in
771 B.f's version will provoke full recompilation of A, producing an identical A.o,
772 and A.hi differing only in its usage-version of B.f (which isn't used by any importer).
774 For (2), because of the tricky B.h question above, we ensure that A.hi is touched
775 (even if identical to its previous version) if A's recompilation was triggered by
776 an imported .hi file date change. Given that, there's no need to record B.f in
779 On the other hand, if A exports "module B" then we *do* count module B among
780 A's usages, because we must recompile A to ensure that A.hi changes appropriately.
783 getImportVersions :: Module -- Name of this module
784 -> Maybe [IE any] -- Export list for this module
785 -> RnMG (VersionInfo Name) -- Version info for these names
787 getImportVersions this_mod exports
788 = getIfacesRn `thenRn` \ ifaces ->
790 Ifaces _ mod_map _ _ imp_names _ _ _ = ifaces
792 -- mv_map groups together all the things imported from a particular module.
793 mv_map, mv_map_mod :: FiniteMap Module (WhatsImported Name)
795 mv_map_mod = foldl add_mod emptyFM export_mods
796 -- mv_map_mod records all the modules that have a "module M"
797 -- in this module's export list with an "Everything"
799 mv_map = foldl add_mv mv_map_mod imp_names
800 -- mv_map adds the version numbers of things exported individually
802 mk_version_info (mod, local_versions)
803 = case lookupFM mod_map mod of
804 Just (hif, version, _, _) -> (mod, hif, version, local_versions)
806 returnRn (map mk_version_info (fmToList mv_map))
808 export_mods = case exports of
810 Just es -> [mod | IEModuleContents mod <- es, mod /= this_mod]
812 add_mv mv_map v@(name, version)
813 = addToFM_C add_item mv_map mod (Specifically [v])
815 mod = nameModule name
817 add_item Everything _ = Everything
818 add_item (Specifically xs) _ = Specifically (v:xs)
820 add_mod mv_map mod = addToFM mv_map mod Everything
825 = getIfacesRn `thenRn` \ (Ifaces _ _ _ slurped_names _ _ _ _) ->
826 returnRn (name `elemNameSet` slurped_names)
828 getSlurpedNames :: RnMG NameSet
830 = getIfacesRn `thenRn` \ ifaces ->
832 Ifaces _ _ _ slurped_names _ _ _ _ = ifaces
834 returnRn slurped_names
836 recordSlurp maybe_version necessity avail
837 = {- traceRn (hsep [text "Record slurp:", pprAvail avail,
838 -- NB PprForDebug prints export flag, which is too
839 -- strict; it's a knot-tied thing in RnNames
840 case necessity of {Compulsory -> text "comp"; Optional -> text "opt" } ]) `thenRn_`
842 getIfacesRn `thenRn` \ ifaces ->
844 Ifaces this_mod mod_map decls slurped_names imp_names
845 (insts, tycls_names) deferred_data_decls inst_mods = ifaces
847 new_slurped_names = addAvailToNameSet slurped_names avail
849 new_imp_names = case maybe_version of
850 Just version -> (availName avail, version) : imp_names
853 -- Add to the names that will let in instance declarations;
854 -- but only (a) if it's a type/class
855 -- (b) if it's compulsory (unless the test flag opt_PruneInstDecls is off)
856 new_tycls_names = case avail of
857 AvailTC tc _ | not opt_PruneInstDecls ||
858 case necessity of {Optional -> False; Compulsory -> True }
859 -> tycls_names `addOneToNameSet` tc
860 otherwise -> tycls_names
862 new_ifaces = Ifaces this_mod mod_map decls
865 (insts, new_tycls_names)
869 setIfacesRn new_ifaces
873 %*********************************************************
875 \subsection{Getting binders out of a declaration}
877 %*********************************************************
879 @getDeclBinders@ returns the names for a @RdrNameHsDecl@.
880 It's used for both source code (from @availsFromDecl@) and interface files
883 It doesn't deal with source-code specific things: ValD, DefD. They
884 are handled by the sourc-code specific stuff in RnNames.
887 getDeclBinders :: (RdrName -> SrcLoc -> RnMG Name) -- New-name function
891 getDeclBinders new_name (TyD (TyData _ _ tycon _ condecls _ _ src_loc))
892 = new_name tycon src_loc `thenRn` \ tycon_name ->
893 getConFieldNames new_name condecls `thenRn` \ sub_names ->
894 returnRn (AvailTC tycon_name (tycon_name : nub sub_names))
895 -- The "nub" is because getConFieldNames can legitimately return duplicates,
896 -- when a record declaration has the same field in multiple constructors
898 getDeclBinders new_name (TyD (TySynonym tycon _ _ src_loc))
899 = new_name tycon src_loc `thenRn` \ tycon_name ->
900 returnRn (AvailTC tycon_name [tycon_name])
902 getDeclBinders new_name (ClD (ClassDecl _ cname _ sigs _ _ tname dname src_loc))
903 = new_name cname src_loc `thenRn` \ class_name ->
904 new_name dname src_loc `thenRn` \ datacon_name ->
905 new_name tname src_loc `thenRn` \ tycon_name ->
907 -- Record the names for the class ops
908 mapRn (getClassOpNames new_name) sigs `thenRn` \ sub_names ->
910 returnRn (AvailTC class_name (class_name : datacon_name : tycon_name : sub_names))
912 getDeclBinders new_name (SigD (IfaceSig var ty prags src_loc))
913 = new_name var src_loc `thenRn` \ var_name ->
914 returnRn (Avail var_name)
916 getDeclBinders new_name (DefD _) = returnRn NotAvailable
917 getDeclBinders new_name (InstD _) = returnRn NotAvailable
920 getConFieldNames new_name (ConDecl con _ (RecCon fielddecls) src_loc : rest)
921 = mapRn (\n -> new_name n src_loc) (con:fields) `thenRn` \ cfs ->
922 getConFieldNames new_name rest `thenRn` \ ns ->
925 fields = concat (map fst fielddecls)
927 getConFieldNames new_name (ConDecl con _ _ src_loc : rest)
928 = new_name con src_loc `thenRn` \ n ->
929 getConFieldNames new_name rest `thenRn` \ ns ->
932 getConFieldNames new_name [] = returnRn []
934 getClassOpNames new_name (ClassOpSig op _ _ src_loc) = new_name op src_loc
938 %*********************************************************
940 \subsection{Reading an interface file}
942 %*********************************************************
945 findAndReadIface :: SDoc -> Module
947 -> RnMG (Maybe ParsedIface)
948 -- Nothing <=> file not found, or unreadable, or illegible
949 -- Just x <=> successfully found and parsed
950 findAndReadIface doc_str mod_name as_source
951 = traceRn trace_msg `thenRn_`
952 getSearchPathRn `thenRn` \ dirs ->
955 trace_msg = sep [hsep [ptext SLIT("Reading"),
956 case as_source of { HiBootFile -> ptext SLIT("[boot]"); other -> empty},
957 ptext SLIT("interface for"),
958 ptext mod_name <> semi],
959 nest 4 (ptext SLIT("reason:") <+> doc_str)]
961 -- For import {-# SOURCE #-} Foo, "as_source" will be True
962 -- and we read Foo.hi-boot, not Foo.hi. This is used to break
963 -- loops among modules.
964 mod_suffix hi = case as_source of
965 HiBootFile -> ".hi-boot" -- Ignore `ways' for boot files.
968 try all_dirs [] = traceRn (ptext SLIT("...failed")) `thenRn_`
971 try all_dirs ((dir,hisuf):dirs)
972 = readIface file_path `thenRn` \ read_result ->
974 Nothing -> try all_dirs dirs
975 Just iface -> traceRn (ptext SLIT("...done")) `thenRn_`
976 returnRn (Just iface)
978 file_path = dir ++ '/' : moduleString mod_name ++ (mod_suffix hisuf)
981 @readIface@ trys just one file.
984 readIface :: String -> RnMG (Maybe ParsedIface)
985 -- Nothing <=> file not found, or unreadable, or illegible
986 -- Just x <=> successfully found and parsed
988 = ioToRnMG (hGetStringBuffer file_path) `thenRn` \ read_result ->
989 --traceRn (hcat[ptext SLIT("Opening...."), text file_path]) `thenRn_`
992 case parseIface contents (mkSrcLoc (mkFastString file_path) 1) of
994 failWithRn Nothing err
995 Succeeded (PIface iface) ->
996 returnRn (Just iface)
999 if isDoesNotExistError err then
1002 failWithRn Nothing (cannaeReadFile file_path err)
1005 mkSearchPath takes a string consisting of a colon-separated list
1006 of directories and corresponding suffixes, and turns it into a list
1007 of (directory, suffix) pairs. For example:
1010 mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
1011 = [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
1015 mkSearchPath :: Maybe String -> SearchPath
1016 mkSearchPath Nothing = [(".",".hi")]
1017 mkSearchPath (Just s)
1022 case span (/= '%') s of
1024 case span (/= ':') rs of
1025 (hisuf,_:rest) -> (dir,hisuf):go rest
1026 (hisuf,[]) -> [(dir,hisuf)]
1029 %*********************************************************
1033 %*********************************************************
1037 = hcat [ptext SLIT("Could not find valid interface file "),
1038 quotes (pprModule filename)]
1040 cannaeReadFile file err
1041 = hcat [ptext SLIT("Failed in reading file: "),
1043 ptext SLIT("; error="),
1047 = sep [ptext SLIT("Failed to find interface decl for"),
1048 quotes (ppr name), ptext SLIT("needed at"), ppr loc]
1050 getDeclWarn name loc
1051 = sep [ptext SLIT("Warning: failed to find (optional) interface decl for"),
1052 quotes (ppr name), ptext SLIT("desired at"), ppr loc]