2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[RnIfaces]{Cacheing and Renaming of Interfaces}
7 #include "HsVersions.h"
12 getSpecialInstModules, getDeferredDataDecls,
13 importDecl, recordSlurp,
14 getImportVersions, getSlurpedNames, getRnStats,
23 #if __GLASGOW_HASKELL__ >= 202
24 import GlaExts (trace) -- TEMP
29 import CmdLineOpts ( opt_PruneTyDecls, opt_PruneInstDecls,
30 opt_PprUserLength, opt_IgnoreIfacePragmas
32 import HsSyn ( HsDecl(..), TyDecl(..), ClassDecl(..), HsTyVar, HsExpr, Sig(..), HsType(..),
33 HsBinds(..), MonoBinds, DefaultDecl, ConDecl(..), ConDetails(..), BangType, IfaceSig(..),
34 FixityDecl(..), Fixity, Fake, InPat, InstDecl(..), HsIdInfo,
37 import HsPragmas ( noGenPragmas )
38 import BasicTypes ( SYN_IE(Version), NewOrData(..), IfaceFlavour(..) )
39 import RdrHsSyn ( SYN_IE(RdrNameHsDecl), SYN_IE(RdrNameInstDecl), SYN_IE(RdrNameTyDecl),
42 import RnEnv ( newGlobalName, addImplicitOccsRn, ifaceFlavour,
43 availName, availNames, addAvailToNameSet, pprAvail
45 import RnSource ( rnHsSigType )
47 import RnHsSyn ( SYN_IE(RenamedHsDecl) )
48 import ParseIface ( parseIface )
50 import ErrUtils ( SYN_IE(Error), SYN_IE(Warning) )
51 import FiniteMap ( FiniteMap, sizeFM, emptyFM, unitFM, delFromFM,
52 lookupFM, addToFM, addToFM_C, addListToFM,
55 import Name ( Name {-instance NamedThing-}, Provenance, OccName(..),
56 nameModule, occNameString, moduleString, pprModule, isLocallyDefined,
57 NameSet(..), emptyNameSet, unionNameSets, nameSetToList,
58 minusNameSet, mkNameSet, elemNameSet, nameUnique, addOneToNameSet,
59 isWiredInName, maybeWiredInTyConName, maybeWiredInIdName,
62 import Id ( GenId, Id(..), idType, dataConTyCon, isAlgCon )
63 import TyCon ( TyCon, tyConDataCons, isSynTyCon, getSynTyConDefn )
64 import Type ( namesOfType )
65 import TyVar ( GenTyVar )
66 import SrcLoc ( mkIfaceSrcLoc, SrcLoc )
67 import PrelMods ( gHC__ )
68 import PrelInfo ( cCallishTyKeys )
70 import Maybes ( MaybeErr(..), expectJust, maybeToBool )
71 import ListSetOps ( unionLists )
73 import Outputable ( PprStyle(..) )
74 import Unique ( Unique )
75 import Util ( pprPanic, pprTrace, Ord3(..) )
76 import StringBuffer ( StringBuffer, hGetStringBuffer, freeStringBuffer )
78 #if __GLASGOW_HASKELL__ >= 202
85 %*********************************************************
87 \subsection{Statistics}
89 %*********************************************************
92 getRnStats :: [RenamedHsDecl] -> RnMG Doc
94 = getIfacesRn `thenRn` \ ifaces ->
96 Ifaces this_mod mod_map decls_fm all_names imp_names (unslurped_insts,_) deferred_data_decls inst_mods = ifaces
97 n_mods = sizeFM mod_map
99 decls_imported = filter is_imported_decl all_decls
100 decls_read = [decl | (name, (_, avail, decl)) <- fmToList decls_fm,
101 name == availName avail,
102 -- Data, newtype, and class decls are in the decls_fm
103 -- under multiple names; the tycon/class, and each
104 -- constructor/class op too.
105 not (isLocallyDefined name)
108 (cd_rd, dd_rd, add_rd, nd_rd, and_rd, sd_rd, vd_rd, _) = count_decls decls_read
109 (cd_sp, dd_sp, add_sp, nd_sp, and_sp, sd_sp, vd_sp, id_sp) = count_decls decls_imported
111 inst_decls_unslurped = length (bagToList unslurped_insts)
112 inst_decls_read = id_sp + inst_decls_unslurped
115 [int n_mods <> text " interfaces read",
116 hsep [int cd_sp, text "class decls imported, out of",
117 int cd_rd, text "read"],
118 hsep [int dd_sp, text "data decls imported (of which", int add_sp, text "abstractly), out of",
119 int dd_rd, text "read"],
120 hsep [int nd_sp, text "newtype decls imported (of which", int and_sp, text "abstractly), out of",
121 int nd_rd, text "read"],
122 hsep [int sd_sp, text "type synonym decls imported, out of",
123 int sd_rd, text "read"],
124 hsep [int vd_sp, text "value signatures imported, out of",
125 int vd_rd, text "read"],
126 hsep [int id_sp, text "instance decls imported, out of",
127 int inst_decls_read, text "read"]
130 returnRn (hcat [text "Renamer stats: ", stats])
132 is_imported_decl (DefD _) = False
133 is_imported_decl (ValD _) = False
134 is_imported_decl decl = not (isLocallyDefined (hsDeclName decl))
137 = -- pprTrace "count_decls" (ppr PprDebug decls
142 -- ppr PprDebug imported_decls
145 data_decls, abstract_data_decls,
146 newtype_decls, abstract_newtype_decls,
151 class_decls = length [() | ClD _ <- decls]
152 data_decls = length [() | TyD (TyData DataType _ _ _ _ _ _ _) <- decls]
153 newtype_decls = length [() | TyD (TyData NewType _ _ _ _ _ _ _) <- decls]
154 abstract_data_decls = length [() | TyD (TyData DataType _ _ _ [] _ _ _) <- decls]
155 abstract_newtype_decls = length [() | TyD (TyData NewType _ _ _ [] _ _ _) <- decls]
156 syn_decls = length [() | TyD (TySynonym _ _ _ _) <- decls]
157 val_decls = length [() | SigD _ <- decls]
158 inst_decls = length [() | InstD _ <- decls]
162 %*********************************************************
164 \subsection{Loading a new interface file}
166 %*********************************************************
169 loadInterface :: Doc -> Module -> IfaceFlavour -> RnMG Ifaces
170 loadInterface doc_str load_mod as_source
171 = getIfacesRn `thenRn` \ ifaces ->
173 Ifaces this_mod mod_map decls
174 all_names imp_names (insts, tycls_names)
175 deferred_data_decls inst_mods = ifaces
177 -- CHECK WHETHER WE HAVE IT ALREADY
178 case lookupFM mod_map load_mod of {
179 Just (hif, _, _, _) | hif `as_good_as` as_source
180 -> -- Already in the cache; don't re-read it
184 -- READ THE MODULE IN
185 findAndReadIface doc_str load_mod as_source `thenRn` \ read_result ->
186 case read_result of {
187 -- Check for not found
188 Nothing -> -- Not found, so add an empty export env to the Ifaces map
189 -- so that we don't look again
191 new_mod_map = addToFM mod_map load_mod (HiFile, 0, [],[])
192 new_ifaces = Ifaces this_mod new_mod_map
193 decls all_names imp_names (insts, tycls_names)
194 deferred_data_decls inst_mods
196 setIfacesRn new_ifaces `thenRn_`
197 failWithRn new_ifaces (noIfaceErr load_mod) ;
200 Just (ParsedIface _ mod_vers usages exports rd_inst_mods fixs rd_decls rd_insts) ->
202 -- LOAD IT INTO Ifaces
203 -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
204 --- names is done correctly (notably, whether this is an .hi file or .hi-boot file).
205 -- If we do loadExport first the wrong info gets into the cache (unless we
206 -- explicitly tag each export which seems a bit of a bore)
207 foldlRn (loadDecl load_mod as_source) decls rd_decls `thenRn` \ new_decls ->
208 mapRn loadExport exports `thenRn` \ avails_s ->
209 foldlRn (loadInstDecl load_mod) insts rd_insts `thenRn` \ new_insts ->
211 mod_details = (as_source, mod_vers, concat avails_s, fixs)
213 -- Exclude this module from the "special-inst" modules
214 new_inst_mods = inst_mods `unionLists` (filter (/= this_mod) rd_inst_mods)
216 new_ifaces = Ifaces this_mod
217 (addToFM mod_map load_mod mod_details)
220 (new_insts, tycls_names)
224 setIfacesRn new_ifaces `thenRn_`
228 as_good_as HiFile any = True
229 as_good_as any HiBootFile = True
230 as_good_as _ _ = False
233 loadExport :: ExportItem -> RnMG [AvailInfo]
234 loadExport (mod, hif, entities)
235 = mapRn load_entity entities
237 new_name occ = newGlobalName mod occ hif
239 load_entity (Avail occ)
240 = new_name occ `thenRn` \ name ->
241 returnRn (Avail name)
242 load_entity (AvailTC occ occs)
243 = new_name occ `thenRn` \ name ->
244 mapRn new_name occs `thenRn` \ names ->
245 returnRn (AvailTC name names)
250 -> (Version, RdrNameHsDecl)
252 loadDecl mod as_source decls_map (version, decl)
253 = getDeclBinders new_implicit_name decl `thenRn` \ avail ->
254 returnRn (addListToFM decls_map
255 [(name,(version,avail,decl')) | name <- availNames avail]
259 If a signature decl is being loaded and we're ignoring interface pragmas,
260 toss away unfolding information.
262 Also, if the signature is loaded from a module we're importing from source,
263 we do the same. This is to avoid situations when compiling a pair of mutually
264 recursive modules, peering at unfolding info in the interface file of the other,
265 e.g., you compile A, it looks at B's interface file and may as a result change
266 it's interface file. Hence, B is recompiled, maybe changing it's interface file,
267 which will the ufolding info used in A to become invalid. Simple way out is to
268 just ignore unfolding info.
272 SigD (IfaceSig name tp ls loc) | from_hi_boot || opt_IgnoreIfacePragmas ->
273 SigD (IfaceSig name tp [] loc)
276 new_implicit_name rdr_name loc = newGlobalName mod (rdrNameOcc rdr_name) as_source
277 from_hi_boot = case as_source of
281 loadInstDecl :: Module
284 -> RnMG (Bag IfaceInst)
285 loadInstDecl mod_name insts decl@(InstDecl inst_ty binds uprags dfun_name src_loc)
287 -- Find out what type constructors and classes are "gates" for the
288 -- instance declaration. If all these "gates" are slurped in then
289 -- we should slurp the instance decl too.
291 -- We *don't* want to count names in the context part as gates, though.
293 -- instance Foo a => Baz (T a) where ...
295 -- Here the gates are Baz and T, but *not* Foo.
297 munged_inst_ty = case inst_ty of
298 HsForAllTy tvs cxt ty -> HsForAllTy tvs [] ty
299 HsPreForAllTy cxt ty -> HsPreForAllTy [] ty
302 -- We find the gates by renaming the instance type with in a
303 -- and returning the occurrence pool.
304 initRnMS emptyRnEnv mod_name (InterfaceMode Compulsory) (
305 findOccurrencesRn (rnHsSigType (\sty -> text "an instance decl") munged_inst_ty)
306 ) `thenRn` \ gate_names ->
307 returnRn (((mod_name, decl), gate_names) `consBag` insts)
311 %********************************************************
313 \subsection{Loading usage information}
315 %********************************************************
318 checkUpToDate :: Module -> RnMG Bool -- True <=> no need to recompile
319 checkUpToDate mod_name
320 = findAndReadIface doc_str mod_name HiFile `thenRn` \ read_result ->
322 -- CHECK WHETHER WE HAVE IT ALREADY
324 Nothing -> -- Old interface file not found, so we'd better bail out
325 traceRn (sep [ptext SLIT("Didnt find old iface"),
326 pprModule PprDebug mod_name]) `thenRn_`
329 Just (ParsedIface _ _ usages _ _ _ _ _)
330 -> -- Found it, so now check it
333 -- Only look in current directory, with suffix .hi
334 doc_str = sep [ptext SLIT("need usage info from"), pprModule PprDebug mod_name]
336 checkModUsage [] = returnRn True -- Yes! Everything is up to date!
338 checkModUsage ((mod, hif, old_mod_vers, old_local_vers) : rest)
339 = loadInterface doc_str mod hif `thenRn` \ ifaces ->
341 Ifaces _ mod_map decls _ _ _ _ _ = ifaces
342 maybe_new_mod_vers = lookupFM mod_map mod
343 Just (_, new_mod_vers, _, _) = maybe_new_mod_vers
345 -- If we can't find a version number for the old module then
346 -- bail out saying things aren't up to date
347 if not (maybeToBool maybe_new_mod_vers) then
348 traceRn (sep [ptext SLIT("Can't find version number for module"), pprModule PprDebug mod]) `thenRn_`
352 -- If the module version hasn't changed, just move on
353 if new_mod_vers == old_mod_vers then
354 traceRn (sep [ptext SLIT("Module version unchanged:"), pprModule PprDebug mod]) `thenRn_`
357 traceRn (sep [ptext SLIT("Module version has changed:"), pprModule PprDebug mod]) `thenRn_`
359 -- New module version, so check entities inside
360 checkEntityUsage mod decls old_local_vers `thenRn` \ up_to_date ->
362 traceRn (ptext SLIT("...but the bits I use haven't.")) `thenRn_`
363 checkModUsage rest -- This one's ok, so check the rest
365 returnRn False -- This one failed, so just bail out now
367 doc_str = sep [ptext SLIT("need version info for"), pprModule PprDebug mod]
370 checkEntityUsage mod decls []
371 = returnRn True -- Yes! All up to date!
373 checkEntityUsage mod decls ((occ_name,old_vers) : rest)
374 = newGlobalName mod occ_name HiFile {- ?? -} `thenRn` \ name ->
375 case lookupFM decls name of
377 Nothing -> -- We used it before, but it ain't there now
378 putDocRn (sep [ptext SLIT("No longer exported:"), ppr PprDebug name]) `thenRn_`
381 Just (new_vers,_,_) -- It's there, but is it up to date?
382 | new_vers == old_vers
383 -- Up to date, so check the rest
384 -> checkEntityUsage mod decls rest
387 -- Out of date, so bale out
388 -> putDocRn (sep [ptext SLIT("Out of date:"), ppr PprDebug name]) `thenRn_`
393 %*********************************************************
395 \subsection{Getting in a declaration}
397 %*********************************************************
400 importDecl :: Name -> Necessity -> RnMG (Maybe RdrNameHsDecl)
401 -- Returns Nothing for a wired-in or already-slurped decl
403 importDecl name necessity
404 = checkSlurped name `thenRn` \ already_slurped ->
405 if already_slurped then
406 -- traceRn (sep [text "Already slurped:", ppr PprDebug name]) `thenRn_`
407 returnRn Nothing -- Already dealt with
409 if isWiredInName name then
410 getWiredInDecl name necessity
412 getIfacesRn `thenRn` \ ifaces ->
414 Ifaces this_mod _ _ _ _ _ _ _ = ifaces
415 mod = nameModule name
417 if mod == this_mod then -- Don't bring in decls from
418 pprTrace "importDecl wierdness:" (ppr PprDebug name) $
419 returnRn Nothing -- the renamed module's own interface file
422 getNonWiredInDecl name necessity
426 getNonWiredInDecl :: Name -> Necessity -> RnMG (Maybe RdrNameHsDecl)
427 getNonWiredInDecl needed_name necessity
428 = traceRn doc_str `thenRn_`
429 loadInterface doc_str mod (ifaceFlavour needed_name) `thenRn` \ (Ifaces _ _ decls _ _ _ _ _) ->
430 case lookupFM decls needed_name of
432 -- Special case for data/newtype type declarations
433 Just (version, avail, TyD ty_decl) | is_data_or_newtype ty_decl
434 -> getNonWiredDataDecl needed_name version avail ty_decl `thenRn` \ (avail', maybe_decl) ->
435 recordSlurp (Just version) necessity avail' `thenRn_`
438 Just (version,avail,decl)
439 -> recordSlurp (Just version) necessity avail `thenRn_`
442 Nothing -> -- Can happen legitimately for "Optional" occurrences
444 Optional -> addWarnRn (getDeclWarn needed_name);
445 other -> addErrRn (getDeclErr needed_name)
449 doc_str = sep [ptext SLIT("need decl for"), ppr PprDebug needed_name]
450 mod = nameModule needed_name
452 is_data_or_newtype (TyData _ _ _ _ _ _ _ _) = True
453 is_data_or_newtype other = False
457 @getWiredInDecl@ maps a wired-in @Name@ to what it makes available.
458 It behaves exactly as if the wired in decl were actually in an interface file.
461 * if the wired-in name is a data type constructor or a data constructor,
462 it brings in the type constructor and all the data constructors; and
463 marks as "occurrences" any free vars of the data con.
465 * similarly for synonum type constructor
467 * if the wired-in name is another wired-in Id, it marks as "occurrences"
468 the free vars of the Id's type.
470 * it loads the interface file for the wired-in thing for the
471 sole purpose of making sure that its instance declarations are available
473 All this is necessary so that we know all types that are "in play", so
474 that we know just what instances to bring into scope.
477 getWiredInDecl name necessity
478 = initRnMS emptyRnEnv mod_name (InterfaceMode necessity)
479 get_wired `thenRn` \ avail ->
480 recordSlurp Nothing necessity avail `thenRn_`
482 -- Force in the home module in case it has instance decls for
483 -- the thing we are interested in.
485 -- Mini hack 1: no point for non-tycons/class; and if we
486 -- do this we find PrelNum trying to import PackedString,
487 -- because PrelBase's .hi file mentions PackedString.unpackString
488 -- But PackedString.hi isn't built by that point!
490 -- Mini hack 2; GHC is guaranteed not to have
491 -- instance decls, so it's a waste of time to read it
493 -- NB: We *must* look at the availName of the slurped avail,
494 -- not the name passed to getWiredInDecl! Why? Because if a data constructor
495 -- or class op is passed to getWiredInDecl we'll pull in the whole data/class
496 -- decl, and recordSlurp will record that fact. But since the data constructor
497 -- isn't a tycon/class we won't force in the home module. And even if the
498 -- type constructor/class comes along later, loadDecl will say that it's already
499 -- been slurped, so getWiredInDecl won't even be called. Pretty obscure bug, this was.
501 main_name = availName avail
502 main_is_tc = case avail of { AvailTC _ _ -> True; Avail _ -> False }
503 mod = nameModule main_name
504 doc_str = sep [ptext SLIT("need home module for wired in thing"), ppr PprDebug name]
506 (if not main_is_tc || mod == gHC__ then
509 loadInterface doc_str mod (ifaceFlavour main_name) `thenRn_`
513 returnRn Nothing -- No declaration to process further
516 get_wired | is_tycon -- ... a type constructor
517 = get_wired_tycon the_tycon
519 | (isAlgCon the_id) -- ... a wired-in data constructor
520 = get_wired_tycon (dataConTyCon the_id)
522 | otherwise -- ... a wired-in non data-constructor
523 = get_wired_id the_id
525 mod_name = nameModule name
526 maybe_wired_in_tycon = maybeWiredInTyConName name
527 is_tycon = maybeToBool maybe_wired_in_tycon
528 maybe_wired_in_id = maybeWiredInIdName name
529 Just the_tycon = maybe_wired_in_tycon
530 Just the_id = maybe_wired_in_id
534 = addImplicitOccsRn id_mentions `thenRn_`
535 returnRn (Avail (getName id))
537 id_mentions = nameSetToList (namesOfType ty)
540 get_wired_tycon tycon
542 = addImplicitOccsRn (nameSetToList mentioned) `thenRn_`
543 returnRn (AvailTC tc_name [tc_name])
545 tc_name = getName tycon
546 (tyvars,ty) = getSynTyConDefn tycon
547 mentioned = namesOfType ty `minusNameSet` mkNameSet (map getName tyvars)
549 get_wired_tycon tycon
550 | otherwise -- data or newtype
551 = addImplicitOccsRn (nameSetToList mentioned) `thenRn_`
552 returnRn (AvailTC tycon_name (tycon_name : map getName data_cons))
554 tycon_name = getName tycon
555 data_cons = tyConDataCons tycon
556 mentioned = foldr (unionNameSets . namesOfType . idType) emptyNameSet data_cons
561 %*********************************************************
563 \subsection{Getting what a module exports}
565 %*********************************************************
568 getInterfaceExports :: Module -> IfaceFlavour -> RnMG (Avails, [(OccName,Fixity)])
569 getInterfaceExports mod as_source
570 = loadInterface doc_str mod as_source `thenRn` \ (Ifaces _ mod_map _ _ _ _ _ _) ->
571 case lookupFM mod_map mod of
572 Nothing -> -- Not there; it must be that the interface file wasn't found;
573 -- the error will have been reported already.
574 -- (Actually loadInterface should put the empty export env in there
575 -- anyway, but this does no harm.)
578 Just (_, _, avails, fixities) -> returnRn (avails, fixities)
580 doc_str = sep [pprModule PprDebug mod, ptext SLIT("is directly imported")]
584 %*********************************************************
586 \subsection{Data type declarations are handled specially}
588 %*********************************************************
590 Data type declarations get special treatment. If we import a data type decl
591 with all its constructors, we end up importing all the types mentioned in
592 the constructors' signatures, and hence {\em their} data type decls, and so on.
593 In effect, we get the transitive closure of data type decls. Worse, this drags
594 in tons on instance decls, and their unfoldings, and so on.
596 If only the type constructor is mentioned, then all this is a waste of time.
597 If any of the data constructors are mentioned then we really have to
598 drag in the whole declaration.
600 So when we import the type constructor for a @data@ or @newtype@ decl, we
601 put it in the "deferred data/newtype decl" pile in Ifaces. Right at the end
602 we slurp these decls, if they havn't already been dragged in by an occurrence
606 getNonWiredDataDecl needed_name
608 avail@(AvailTC tycon_name _)
609 ty_decl@(TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc)
610 | needed_name == tycon_name
612 && not (nameUnique needed_name `elem` cCallishTyKeys) -- Hack! Don't prune these tycons whose constructors
613 -- the desugarer must be able to see when desugaring
615 = -- Need the type constructor; so put it in the deferred set for now
616 getIfacesRn `thenRn` \ ifaces ->
618 Ifaces this_mod mod_map decls_fm slurped_names imp_names unslurped_insts deferred_data_decls inst_mods = ifaces
619 new_ifaces = Ifaces this_mod mod_map decls_fm slurped_names imp_names unslurped_insts new_deferred_data_decls inst_mods
621 no_constr_ty_decl = TyData new_or_data [] tycon tyvars [] derivings pragmas src_loc
622 new_deferred_data_decls = addToFM deferred_data_decls tycon_name no_constr_ty_decl
623 -- Nota bene: we nuke both the constructors and the context in the deferred decl.
624 -- If we don't nuke the context then renaming the deferred data decls can give
625 -- new unresolved names (for the classes). This could be handled, but there's
626 -- no point. If the data type is completely abstract then we aren't interested
629 setIfacesRn new_ifaces `thenRn_`
630 returnRn (AvailTC tycon_name [tycon_name], Nothing)
633 = -- Need a data constructor, so delete the data decl from the deferred set if it's there
634 getIfacesRn `thenRn` \ ifaces ->
636 Ifaces this_mod mod_map decls_fm slurped_names imp_names unslurped_insts deferred_data_decls inst_mods = ifaces
637 new_ifaces = Ifaces this_mod mod_map decls_fm slurped_names imp_names unslurped_insts new_deferred_data_decls inst_mods
639 new_deferred_data_decls = delFromFM deferred_data_decls tycon_name
641 setIfacesRn new_ifaces `thenRn_`
642 returnRn (avail, Just (TyD ty_decl))
646 getDeferredDataDecls :: RnMG [(Name, RdrNameTyDecl)]
648 = getIfacesRn `thenRn` \ (Ifaces _ _ _ _ _ _ deferred_data_decls _) ->
650 deferred_list = fmToList deferred_data_decls
651 trace_msg = hang (text "Slurping abstract data/newtype decls for: ")
652 4 (ppr PprDebug (map fst deferred_list))
654 traceRn trace_msg `thenRn_`
655 returnRn deferred_list
659 %*********************************************************
661 \subsection{Instance declarations are handled specially}
663 %*********************************************************
666 getImportedInstDecls :: RnMG [(Module,RdrNameInstDecl)]
668 = -- First load any special-instance modules that aren't aready loaded
669 getSpecialInstModules `thenRn` \ inst_mods ->
670 mapRn load_it inst_mods `thenRn_`
672 -- Now we're ready to grab the instance declarations
673 -- Find the un-gated ones and return them,
674 -- removing them from the bag kept in Ifaces
675 getIfacesRn `thenRn` \ ifaces ->
677 Ifaces this_mod mod_map decls slurped_names imp_names (insts, tycls_names) deferred_data_decls inst_mods = ifaces
679 -- An instance decl is ungated if all its gates have been slurped
680 select_ungated :: IfaceInst -- A gated inst decl
682 -> ([(Module, RdrNameInstDecl)], [IfaceInst]) -- Accumulator
684 -> ([(Module, RdrNameInstDecl)], -- The ungated ones
685 [IfaceInst]) -- Still gated, but with
687 select_ungated (decl,gates) (ungated_decls, gated_decls)
688 | null remaining_gates
689 = (decl : ungated_decls, gated_decls)
691 = (ungated_decls, (decl, remaining_gates) : gated_decls)
693 remaining_gates = filter (not . (`elemNameSet` tycls_names)) gates
695 (un_gated_insts, still_gated_insts) = foldrBag select_ungated ([], []) insts
697 new_ifaces = Ifaces this_mod mod_map decls slurped_names imp_names
698 ((listToBag still_gated_insts), tycls_names)
699 -- NB: don't throw away tycls_names; we may comre across more instance decls
703 traceRn (sep [text "getInstDecls:", fsep (map (ppr PprDebug) (nameSetToList tycls_names))]) `thenRn_`
704 setIfacesRn new_ifaces `thenRn_`
705 returnRn un_gated_insts
707 load_it mod = loadInterface (doc_str mod) mod HiFile
708 doc_str mod = sep [pprModule PprDebug mod, ptext SLIT("is a special-instance module")]
711 getSpecialInstModules :: RnMG [Module]
712 getSpecialInstModules
713 = getIfacesRn `thenRn` \ ifaces ->
715 Ifaces _ _ _ _ _ _ _ inst_mods = ifaces
721 %*********************************************************
723 \subsection{Keeping track of what we've slurped, and version numbers}
725 %*********************************************************
727 getImportVersions figures out what the "usage information" for this moudule is;
728 that is, what it must record in its interface file as the things it uses.
730 - anything reachable from its body code
731 - any module exported with a "module Foo".
733 Why the latter? Because if Foo changes then this module's export list
734 will change, so we must recompile this module at least as far as
735 making a new interface file --- but in practice that means complete
739 module A( f, g ) where module B( f ) where
740 import B( f ) f = h 3
743 Should we record B.f in A's usages? In fact we don't. Certainly, if
744 anything about B.f changes than anyone who imports A should be recompiled;
745 they'll get an early exit if they don't use B.f. However, even if B.f
746 doesn't change at all, B.h may do so, and this change may not be reflected
747 in f's version number. So there are two things going on when compiling module A:
749 1. Are A.o and A.hi correct? Then we can bale out early.
750 2. Should modules that import A be recompiled?
752 For (1) it is slightly harmful to record B.f in A's usages, because a change in
753 B.f's version will provoke full recompilation of A, producing an identical A.o,
754 and A.hi differing only in its usage-version of B.f (which isn't used by any importer).
756 For (2), because of the tricky B.h question above, we ensure that A.hi is touched
757 (even if identical to its previous version) if A's recompilation was triggered by
758 an imported .hi file date change. Given that, there's no need to record B.f in
761 On the other hand, if A exports "module B" then we *do* count module B among
762 A's usages, because we must recompile A to ensure that A.hi changes appropriately.
765 getImportVersions :: Module -- Name of this module
766 -> Maybe [IE any] -- Export list for this module
767 -> RnMG (VersionInfo Name) -- Version info for these names
769 getImportVersions this_mod exports
770 = getIfacesRn `thenRn` \ ifaces ->
772 Ifaces _ mod_map _ _ imp_names _ _ _ = ifaces
774 -- mv_map groups together all the things imported from a particular module.
775 mv_map, mv_map_mod :: FiniteMap Module [LocalVersion Name]
777 mv_map_mod = foldl add_mod emptyFM export_mods
778 -- mv_map_mod records all the modules that have a "module M"
779 -- in this module's export list
781 mv_map = foldl add_mv mv_map_mod imp_names
782 -- mv_map adds the version numbers of things exported individually
784 mk_version_info (mod, local_versions)
785 = case lookupFM mod_map mod of
786 Just (hif, version, _, _) -> (mod, hif, version, local_versions)
788 returnRn (map mk_version_info (fmToList mv_map))
790 export_mods = case exports of
792 Just es -> [mod | IEModuleContents mod <- es, mod /= this_mod]
794 add_mv mv_map v@(name, version)
795 = addToFM_C (\ ls _ -> (v:ls)) mv_map mod [v]
797 mod = nameModule name
799 add_mod mv_map mod = addToFM mv_map mod []
804 = getIfacesRn `thenRn` \ (Ifaces _ _ _ slurped_names _ _ _ _) ->
805 returnRn (name `elemNameSet` slurped_names)
807 getSlurpedNames :: RnMG NameSet
809 = getIfacesRn `thenRn` \ ifaces ->
811 Ifaces _ _ _ slurped_names _ _ _ _ = ifaces
813 returnRn slurped_names
815 recordSlurp maybe_version necessity avail
816 = {- traceRn (hsep [text "Record slurp:", pprAvail (PprForUser opt_PprUserLength) avail,
817 -- NB PprForDebug prints export flag, which is too
818 -- strict; it's a knot-tied thing in RnNames
819 case necessity of {Compulsory -> text "comp"; Optional -> text "opt" } ]) `thenRn_`
821 getIfacesRn `thenRn` \ ifaces ->
823 Ifaces this_mod mod_map decls slurped_names imp_names (insts, tycls_names) deferred_data_decls inst_mods = ifaces
824 new_slurped_names = addAvailToNameSet slurped_names avail
826 new_imp_names = case maybe_version of
827 Just version -> (availName avail, version) : imp_names
830 -- Add to the names that will let in instance declarations;
831 -- but only (a) if it's a type/class
832 -- (b) if it's compulsory (unless the test flag opt_PruneInstDecls is off)
833 new_tycls_names = case avail of
834 AvailTC tc _ | not opt_PruneInstDecls ||
835 case necessity of {Optional -> False; Compulsory -> True }
836 -> tycls_names `addOneToNameSet` tc
837 otherwise -> tycls_names
839 new_ifaces = Ifaces this_mod mod_map decls
842 (insts, new_tycls_names)
846 setIfacesRn new_ifaces
850 %*********************************************************
852 \subsection{Getting binders out of a declaration}
854 %*********************************************************
856 @getDeclBinders@ returns the names for a @RdrNameHsDecl@.
857 It's used for both source code (from @availsFromDecl@) and interface files
860 It doesn't deal with source-code specific things: ValD, DefD. They
861 are handled by the sourc-code specific stuff in RnNames.
864 getDeclBinders :: (RdrName -> SrcLoc -> RnMG Name) -- New-name function
868 getDeclBinders new_name (TyD (TyData _ _ tycon _ condecls _ _ src_loc))
869 = new_name tycon src_loc `thenRn` \ tycon_name ->
870 getConFieldNames new_name condecls `thenRn` \ sub_names ->
871 returnRn (AvailTC tycon_name (tycon_name : nub sub_names))
872 -- The "nub" is because getConFieldNames can legitimately return duplicates,
873 -- when a record declaration has the same field in multiple constructors
875 getDeclBinders new_name (TyD (TySynonym tycon _ _ src_loc))
876 = new_name tycon src_loc `thenRn` \ tycon_name ->
877 returnRn (AvailTC tycon_name [tycon_name])
879 getDeclBinders new_name (ClD (ClassDecl _ cname _ sigs _ _ src_loc))
880 = new_name cname src_loc `thenRn` \ class_name ->
881 mapRn (getClassOpNames new_name) sigs `thenRn` \ sub_names ->
882 returnRn (AvailTC class_name (class_name : sub_names))
884 getDeclBinders new_name (SigD (IfaceSig var ty prags src_loc))
885 = new_name var src_loc `thenRn` \ var_name ->
886 returnRn (Avail var_name)
888 getDeclBinders new_name (DefD _) = returnRn NotAvailable
889 getDeclBinders new_name (InstD _) = returnRn NotAvailable
892 getConFieldNames new_name (ConDecl con _ (RecCon fielddecls) src_loc : rest)
893 = mapRn (\n -> new_name n src_loc) (con:fields) `thenRn` \ cfs ->
894 getConFieldNames new_name rest `thenRn` \ ns ->
897 fields = concat (map fst fielddecls)
899 getConFieldNames new_name (ConDecl con _ _ src_loc : rest)
900 = new_name con src_loc `thenRn` \ n ->
901 getConFieldNames new_name rest `thenRn` \ ns ->
904 getConFieldNames new_name [] = returnRn []
906 getClassOpNames new_name (ClassOpSig op _ _ src_loc) = new_name op src_loc
910 %*********************************************************
912 \subsection{Reading an interface file}
914 %*********************************************************
917 findAndReadIface :: Doc -> Module
919 -> RnMG (Maybe ParsedIface)
920 -- Nothing <=> file not found, or unreadable, or illegible
921 -- Just x <=> successfully found and parsed
922 findAndReadIface doc_str mod_name as_source
923 = traceRn trace_msg `thenRn_`
924 getSearchPathRn `thenRn` \ dirs ->
927 trace_msg = sep [hsep [ptext SLIT("Reading"),
928 case as_source of { HiBootFile -> ptext SLIT("[boot]"); other -> empty},
929 ptext SLIT("interface for"),
930 ptext mod_name <> semi],
931 nest 4 (ptext SLIT("reason:") <+> doc_str)]
933 -- For import {-# SOURCE #-} Foo, "as_source" will be True
934 -- and we read Foo.hi-boot, not Foo.hi. This is used to break
935 -- loops among modules.
936 mod_suffix hi = case as_source of
937 HiBootFile -> ".hi-boot" -- Ignore `ways' for boot files.
940 try all_dirs [] = traceRn (ptext SLIT("...failed")) `thenRn_`
943 try all_dirs ((dir,hisuf):dirs)
944 = readIface file_path `thenRn` \ read_result ->
946 Nothing -> try all_dirs dirs
947 Just iface -> traceRn (ptext SLIT("...done")) `thenRn_`
948 returnRn (Just iface)
950 file_path = dir ++ '/' : moduleString mod_name ++ (mod_suffix hisuf)
953 @readIface@ trys just one file.
956 readIface :: String -> RnMG (Maybe ParsedIface)
957 -- Nothing <=> file not found, or unreadable, or illegible
958 -- Just x <=> successfully found and parsed
960 = ioToRnMG (hGetStringBuffer file_path) `thenRn` \ read_result ->
961 --traceRn (hcat[ptext SLIT("Opening...."), text file_path]) `thenRn_`
964 case parseIface contents 1 of
966 --traceRn (ptext SLIT("parse err")) `thenRn_`
967 failWithRn Nothing err
969 --traceRn (ptext SLIT("parse cool")) `thenRn_`
970 returnRn (Just iface)
972 #if __GLASGOW_HASKELL__ >= 202
974 if isDoesNotExistError err then
975 --traceRn (ptext SLIT("no file")) `thenRn_`
978 --traceRn (ptext SLIT("uh-oh..")) `thenRn_`
979 failWithRn Nothing (cannaeReadFile file_path err)
980 #else /* 2.01 and 0.2x */
981 Left (NoSuchThing _) -> returnRn Nothing
983 Left err -> failWithRn Nothing
984 (cannaeReadFile file_path err)
989 mkSearchPath takes a string consisting of a colon-separated list
990 of directories and corresponding suffixes, and turns it into a list
991 of (directory, suffix) pairs. For example:
994 mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
995 = [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
999 mkSearchPath :: Maybe String -> SearchPath
1000 mkSearchPath Nothing = [(".",".hi")]
1001 mkSearchPath (Just s)
1006 case span (/= '%') s of
1008 case span (/= ':') rs of
1009 (hisuf,_:rest) -> (dir,hisuf):go rest
1010 (hisuf,[]) -> [(dir,hisuf)]
1013 %*********************************************************
1017 %*********************************************************
1020 noIfaceErr filename sty
1021 = hcat [ptext SLIT("Could not find valid interface file "),
1022 quotes (pprModule sty filename)]
1024 cannaeReadFile file err sty
1025 = hcat [ptext SLIT("Failed in reading file: "),
1027 ptext SLIT("; error="),
1031 = sep [ptext SLIT("Failed to find interface decl for"),
1034 getDeclWarn name sty
1035 = sep [ptext SLIT("Warning: failed to find (optional) interface decl for"),