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(..) )
39 import RdrHsSyn ( SYN_IE(RdrNameHsDecl), SYN_IE(RdrNameInstDecl), SYN_IE(RdrNameTyDecl),
42 import RnEnv ( newGlobalName, addImplicitOccsRn,
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_vers_map export_envs decls_fm all_names imp_names (unslurped_insts,_) deferred_data_decls inst_mods = ifaces
97 n_mods = sizeFM mod_vers_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 -> Bool -> RnMG Ifaces
170 loadInterface doc_str load_mod as_source
171 = getIfacesRn `thenRn` \ ifaces ->
173 Ifaces this_mod mod_vers_map export_envs decls
174 all_names imp_names (insts, tycls_names)
175 deferred_data_decls inst_mods = ifaces
177 -- CHECK WHETHER WE HAVE IT ALREADY
178 if maybeToBool (lookupFM export_envs load_mod)
180 returnRn ifaces -- Already in the cache; don't re-read it
183 -- READ THE MODULE IN
184 findAndReadIface doc_str load_mod `thenRn` \ read_result ->
185 case read_result of {
186 -- Check for not found
187 Nothing -> -- Not found, so add an empty export env to the Ifaces map
188 -- so that we don't look again
190 new_export_envs = addToFM export_envs load_mod ([],[])
191 new_ifaces = Ifaces this_mod mod_vers_map
193 decls all_names imp_names (insts, tycls_names) deferred_data_decls inst_mods
195 setIfacesRn new_ifaces `thenRn_`
196 failWithRn new_ifaces (noIfaceErr load_mod) ;
199 Just (ParsedIface _ mod_vers usages exports rd_inst_mods fixs rd_decls rd_insts) ->
201 -- LOAD IT INTO Ifaces
202 mapRn loadExport exports `thenRn` \ avails_s ->
203 foldlRn (loadDecl load_mod as_source) decls rd_decls `thenRn` \ new_decls ->
204 foldlRn (loadInstDecl load_mod) insts rd_insts `thenRn` \ new_insts ->
206 export_env = (concat avails_s, fixs)
208 -- Exclude this module from the "special-inst" modules
209 new_inst_mods = inst_mods `unionLists` (filter (/= this_mod) rd_inst_mods)
211 new_ifaces = Ifaces this_mod
212 (addToFM mod_vers_map load_mod mod_vers)
213 (addToFM export_envs load_mod export_env)
216 (new_insts, tycls_names)
220 setIfacesRn new_ifaces `thenRn_`
224 loadExport :: ExportItem -> RnMG [AvailInfo]
225 loadExport (mod, entities)
226 = mapRn load_entity entities
228 new_name occ = newGlobalName mod occ
230 -- The communcation between this little code fragment and the "entity" rule
231 -- in ParseIface.y is a bit gruesome. The idea is that things which are
232 -- destined to be AvailTCs show up as (occ, [non-empty-list]), whereas
233 -- things destined to be Avails show up as (occ, [])
235 load_entity (occ, occs)
236 = new_name occ `thenRn` \ name ->
238 returnRn (Avail name)
240 mapRn new_name occs `thenRn` \ names ->
241 returnRn (AvailTC name names)
246 -> (Version, RdrNameHsDecl)
248 loadDecl mod as_source decls_map (version, decl)
249 = getDeclBinders new_implicit_name decl `thenRn` \ avail ->
250 returnRn (addListToFM decls_map
251 [(name,(version,avail,decl')) | name <- availNames avail]
255 If a signature decl is being loaded and we're ignoring interface pragmas,
256 toss away unfolding information.
258 Also, if the signature is loaded from a module we're importing from source,
259 we do the same. This is to avoid situations when compiling a pair of mutually
260 recursive modules, peering at unfolding info in the interface file of the other,
261 e.g., you compile A, it looks at B's interface file and may as a result change
262 it's interface file. Hence, B is recompiled, maybe changing it's interface file,
263 which will the ufolding info used in A to become invalid. Simple way out is to
264 just ignore unfolding info.
268 SigD (IfaceSig name tp ls loc) | as_source || opt_IgnoreIfacePragmas ->
269 SigD (IfaceSig name tp [] loc)
272 new_implicit_name rdr_name loc = newGlobalName mod (rdrNameOcc rdr_name)
274 loadInstDecl :: Module
277 -> RnMG (Bag IfaceInst)
278 loadInstDecl mod_name insts decl@(InstDecl inst_ty binds uprags dfun_name src_loc)
280 -- Find out what type constructors and classes are "gates" for the
281 -- instance declaration. If all these "gates" are slurped in then
282 -- we should slurp the instance decl too.
284 -- We *don't* want to count names in the context part as gates, though.
286 -- instance Foo a => Baz (T a) where ...
288 -- Here the gates are Baz and T, but *not* Foo.
290 munged_inst_ty = case inst_ty of
291 HsForAllTy tvs cxt ty -> HsForAllTy tvs [] ty
292 HsPreForAllTy cxt ty -> HsPreForAllTy [] ty
295 -- We find the gates by renaming the instance type with in a
296 -- and returning the occurrence pool.
297 initRnMS emptyRnEnv mod_name (InterfaceMode Compulsory) (
298 findOccurrencesRn (rnHsSigType (\sty -> text "an instance decl") munged_inst_ty)
299 ) `thenRn` \ gate_names ->
300 returnRn (((mod_name, decl), gate_names) `consBag` insts)
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 `thenRn` \ read_result ->
315 Nothing -> -- Old interface file not found, so we'd better bail out
316 traceRn (sep [ptext SLIT("Didnt find old iface"),
317 pprModule PprDebug mod_name]) `thenRn_`
320 Just (ParsedIface _ _ usages _ _ _ _ _)
321 -> -- Found it, so now check it
324 -- Only look in current directory, with suffix .hi
325 doc_str = sep [ptext SLIT("Need usage info from"), pprModule PprDebug mod_name]
327 checkModUsage [] = returnRn True -- Yes! Everything is up to date!
329 checkModUsage ((mod, old_mod_vers, old_local_vers) : rest)
330 = loadInterface doc_str mod False{-not as source-} `thenRn` \ ifaces ->
332 Ifaces _ mod_vers _ decls _ _ _ _ _ = ifaces
333 maybe_new_mod_vers = lookupFM mod_vers mod
334 Just new_mod_vers = maybe_new_mod_vers
336 -- If we can't find a version number for the old module then
337 -- bail out saying things aren't up to date
338 if not (maybeToBool maybe_new_mod_vers) then
342 -- If the module version hasn't changed, just move on
343 if new_mod_vers == old_mod_vers then
344 traceRn (sep [ptext SLIT("Module version unchanged:"), pprModule PprDebug mod]) `thenRn_`
347 traceRn (sep [ptext SLIT("Module version has changed:"), pprModule PprDebug mod]) `thenRn_`
349 -- New module version, so check entities inside
350 checkEntityUsage mod decls old_local_vers `thenRn` \ up_to_date ->
352 traceRn (ptext SLIT("...but the bits I use haven't.")) `thenRn_`
353 checkModUsage rest -- This one's ok, so check the rest
355 returnRn False -- This one failed, so just bail out now
357 doc_str = sep [ptext SLIT("need version info for"), pprModule PprDebug mod]
360 checkEntityUsage mod decls []
361 = returnRn True -- Yes! All up to date!
363 checkEntityUsage mod decls ((occ_name,old_vers) : rest)
364 = newGlobalName mod occ_name `thenRn` \ name ->
365 case lookupFM decls name of
367 Nothing -> -- We used it before, but it ain't there now
368 traceRn (sep [ptext SLIT("...and this no longer exported:"), ppr PprDebug name]) `thenRn_`
371 Just (new_vers,_,_) -- It's there, but is it up to date?
372 | new_vers == old_vers
373 -- Up to date, so check the rest
374 -> checkEntityUsage mod decls rest
377 -- Out of date, so bale out
378 -> traceRn (sep [ptext SLIT("...and this is out of date:"), ppr PprDebug name]) `thenRn_`
383 %*********************************************************
385 \subsection{Getting in a declaration}
387 %*********************************************************
390 importDecl :: Name -> Necessity -> RnMG (Maybe RdrNameHsDecl)
391 -- Returns Nothing for a wired-in or already-slurped decl
393 importDecl name necessity
394 = checkSlurped name `thenRn` \ already_slurped ->
395 if already_slurped then
396 traceRn (sep [text "Already slurped:", ppr PprDebug name]) `thenRn_`
397 returnRn Nothing -- Already dealt with
399 if isWiredInName name then
400 getWiredInDecl name necessity
402 getIfacesRn `thenRn` \ ifaces ->
404 Ifaces this_mod _ _ _ _ _ _ _ _ = ifaces
405 mod = nameModule name
407 if mod == this_mod then -- Don't bring in decls from
408 pprTrace "importDecl wierdness:" (ppr PprDebug name) $
409 returnRn Nothing -- the renamed module's own interface file
412 getNonWiredInDecl name necessity
416 getNonWiredInDecl :: Name -> Necessity -> RnMG (Maybe RdrNameHsDecl)
417 getNonWiredInDecl needed_name necessity
418 = traceRn doc_str `thenRn_`
419 loadInterface doc_str mod False{-not as source -} `thenRn` \ (Ifaces _ _ _ decls _ _ _ _ _) ->
420 case lookupFM decls needed_name of
422 -- Special case for data/newtype type declarations
423 Just (version, avail, TyD ty_decl) | is_data_or_newtype ty_decl
424 -> getNonWiredDataDecl needed_name version avail ty_decl `thenRn` \ (avail', maybe_decl) ->
425 recordSlurp (Just version) necessity avail' `thenRn_`
428 Just (version,avail,decl)
429 -> recordSlurp (Just version) necessity avail `thenRn_`
432 Nothing -> -- Can happen legitimately for "Optional" occurrences
434 Optional -> addWarnRn (getDeclWarn needed_name);
435 other -> addErrRn (getDeclErr needed_name)
439 doc_str = sep [ptext SLIT("Need decl for"), ppr PprDebug needed_name]
440 mod = nameModule needed_name
442 is_data_or_newtype (TyData _ _ _ _ _ _ _ _) = True
443 is_data_or_newtype other = False
446 @getWiredInDecl@ maps a wired-in @Name@ to what it makes available.
447 It behaves exactly as if the wired in decl were actually in an interface file.
450 * if the wired-in name is a data type constructor or a data constructor,
451 it brings in the type constructor and all the data constructors; and
452 marks as "occurrences" any free vars of the data con.
454 * similarly for synonum type constructor
456 * if the wired-in name is another wired-in Id, it marks as "occurrences"
457 the free vars of the Id's type.
459 * it loads the interface file for the wired-in thing for the
460 sole purpose of making sure that its instance declarations are available
462 All this is necessary so that we know all types that are "in play", so
463 that we know just what instances to bring into scope.
466 getWiredInDecl name necessity
467 = initRnMS emptyRnEnv mod_name (InterfaceMode necessity)
468 get_wired `thenRn` \ avail ->
469 recordSlurp Nothing necessity avail `thenRn_`
471 -- Force in the home module in case it has instance decls for
472 -- the thing we are interested in.
474 -- Mini hack 1: no point for non-tycons/class; and if we
475 -- do this we find PrelNum trying to import PackedString,
476 -- because PrelBase's .hi file mentions PackedString.unpackString
477 -- But PackedString.hi isn't built by that point!
479 -- Mini hack 2; GHC is guaranteed not to have
480 -- instance decls, so it's a waste of time to read it
482 -- NB: We *must* look at the availName of the slurped avail,
483 -- not the name passed to getWiredInDecl! Why? Because if a data constructor
484 -- or class op is passed to getWiredInDecl we'll pull in the whole data/class
485 -- decl, and recordSlurp will record that fact. But since the data constructor
486 -- isn't a tycon/class we won't force in the home module. And even if the
487 -- type constructor/class comes along later, loadDecl will say that it's already
488 -- been slurped, so getWiredInDecl won't even be called. Pretty obscure bug, this was.
490 main_name = availName avail
491 main_is_tc = case avail of { AvailTC _ _ -> True; Avail _ -> False }
492 mod = nameModule main_name
493 doc_str = sep [ptext SLIT("Need home module for wired in thing"), ppr PprDebug name]
495 (if not main_is_tc || mod == gHC__ then
498 loadInterface doc_str mod False{-not as source-} `thenRn_`
502 returnRn Nothing -- No declaration to process further
505 get_wired | is_tycon -- ... a type constructor
506 = get_wired_tycon the_tycon
508 | (isAlgCon the_id) -- ... a wired-in data constructor
509 = get_wired_tycon (dataConTyCon the_id)
511 | otherwise -- ... a wired-in non data-constructor
512 = get_wired_id the_id
514 mod_name = nameModule name
515 maybe_wired_in_tycon = maybeWiredInTyConName name
516 is_tycon = maybeToBool maybe_wired_in_tycon
517 maybe_wired_in_id = maybeWiredInIdName name
518 Just the_tycon = maybe_wired_in_tycon
519 Just the_id = maybe_wired_in_id
523 = addImplicitOccsRn (nameSetToList id_mentioned) `thenRn_`
524 returnRn (Avail (getName id))
526 id_mentioned = namesOfType (idType id)
528 get_wired_tycon tycon
530 = addImplicitOccsRn (nameSetToList mentioned) `thenRn_`
531 returnRn (AvailTC tc_name [tc_name])
533 tc_name = getName tycon
534 (tyvars,ty) = getSynTyConDefn tycon
535 mentioned = namesOfType ty `minusNameSet` mkNameSet (map getName tyvars)
537 get_wired_tycon tycon
538 | otherwise -- data or newtype
539 = addImplicitOccsRn (nameSetToList mentioned) `thenRn_`
540 returnRn (AvailTC tycon_name (tycon_name : map getName data_cons))
542 tycon_name = getName tycon
543 data_cons = tyConDataCons tycon
544 mentioned = foldr (unionNameSets . namesOfType . idType) emptyNameSet data_cons
549 %*********************************************************
551 \subsection{Getting what a module exports}
553 %*********************************************************
556 getInterfaceExports :: Module -> Bool -> RnMG (Avails, [(OccName,Fixity)])
557 getInterfaceExports mod as_source
558 = loadInterface doc_str mod as_source `thenRn` \ (Ifaces _ _ export_envs _ _ _ _ _ _) ->
559 case lookupFM export_envs mod of
560 Nothing -> -- Not there; it must be that the interface file wasn't found;
561 -- the error will have been reported already.
562 -- (Actually loadInterface should put the empty export env in there
563 -- anyway, but this does no harm.)
566 Just stuff -> returnRn stuff
568 doc_str = sep [pprModule PprDebug mod, ptext SLIT("is directly imported")]
572 %*********************************************************
574 \subsection{Data type declarations are handled specially}
576 %*********************************************************
578 Data type declarations get special treatment. If we import a data type decl
579 with all its constructors, we end up importing all the types mentioned in
580 the constructors' signatures, and hence {\em their} data type decls, and so on.
581 In effect, we get the transitive closure of data type decls. Worse, this drags
582 in tons on instance decls, and their unfoldings, and so on.
584 If only the type constructor is mentioned, then all this is a waste of time.
585 If any of the data constructors are mentioned then we really have to
586 drag in the whole declaration.
588 So when we import the type constructor for a @data@ or @newtype@ decl, we
589 put it in the "deferred data/newtype decl" pile in Ifaces. Right at the end
590 we slurp these decls, if they havn't already been dragged in by an occurrence
594 getNonWiredDataDecl needed_name
596 avail@(AvailTC tycon_name _)
597 ty_decl@(TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc)
598 | needed_name == tycon_name
600 && not (nameUnique needed_name `elem` cCallishTyKeys) -- Hack! Don't prune these tycons whose constructors
601 -- the desugarer must be able to see when desugaring
603 = -- Need the type constructor; so put it in the deferred set for now
604 getIfacesRn `thenRn` \ ifaces ->
606 Ifaces this_mod mod_vers_map export_envs decls_fm slurped_names imp_names unslurped_insts deferred_data_decls inst_mods = ifaces
607 new_ifaces = Ifaces this_mod mod_vers_map export_envs decls_fm slurped_names imp_names unslurped_insts new_deferred_data_decls inst_mods
609 no_constr_ty_decl = TyData new_or_data [] tycon tyvars [] derivings pragmas src_loc
610 new_deferred_data_decls = addToFM deferred_data_decls tycon_name no_constr_ty_decl
611 -- Nota bene: we nuke both the constructors and the context in the deferred decl.
612 -- If we don't nuke the context then renaming the deferred data decls can give
613 -- new unresolved names (for the classes). This could be handled, but there's
614 -- no point. If the data type is completely abstract then we aren't interested
617 setIfacesRn new_ifaces `thenRn_`
618 returnRn (AvailTC tycon_name [tycon_name], Nothing)
621 = -- Need a data constructor, so delete the data decl from the deferred set if it's there
622 getIfacesRn `thenRn` \ ifaces ->
624 Ifaces this_mod mod_vers_map export_envs decls_fm slurped_names imp_names unslurped_insts deferred_data_decls inst_mods = ifaces
625 new_ifaces = Ifaces this_mod mod_vers_map export_envs decls_fm slurped_names imp_names unslurped_insts new_deferred_data_decls inst_mods
627 new_deferred_data_decls = delFromFM deferred_data_decls tycon_name
629 setIfacesRn new_ifaces `thenRn_`
630 returnRn (avail, Just (TyD ty_decl))
634 getDeferredDataDecls :: RnMG [(Name, RdrNameTyDecl)]
636 = getIfacesRn `thenRn` \ (Ifaces _ _ _ _ _ _ _ deferred_data_decls _) ->
638 deferred_list = fmToList deferred_data_decls
639 trace_msg = hang (text "Slurping abstract data/newtype decls for: ")
640 4 (ppr PprDebug (map fst deferred_list))
642 traceRn trace_msg `thenRn_`
643 returnRn deferred_list
647 %*********************************************************
649 \subsection{Instance declarations are handled specially}
651 %*********************************************************
654 getImportedInstDecls :: RnMG [(Module,RdrNameInstDecl)]
656 = -- First load any special-instance modules that aren't aready loaded
657 getSpecialInstModules `thenRn` \ inst_mods ->
658 mapRn load_it inst_mods `thenRn_`
660 -- Now we're ready to grab the instance declarations
661 -- Find the un-gated ones and return them,
662 -- removing them from the bag kept in Ifaces
663 getIfacesRn `thenRn` \ ifaces ->
665 Ifaces this_mod mod_vers export_envs decls slurped_names imp_names (insts, tycls_names) deferred_data_decls inst_mods = ifaces
667 -- An instance decl is ungated if all its gates have been slurped
668 select_ungated :: IfaceInst -- A gated inst decl
670 -> ([(Module, RdrNameInstDecl)], [IfaceInst]) -- Accumulator
672 -> ([(Module, RdrNameInstDecl)], -- The ungated ones
673 [IfaceInst]) -- Still gated, but with
675 select_ungated (decl,gates) (ungated_decls, gated_decls)
676 | null remaining_gates
677 = (decl : ungated_decls, gated_decls)
679 = (ungated_decls, (decl, remaining_gates) : gated_decls)
681 remaining_gates = filter (not . (`elemNameSet` tycls_names)) gates
683 (un_gated_insts, still_gated_insts) = foldrBag select_ungated ([], []) insts
685 new_ifaces = Ifaces this_mod mod_vers export_envs decls slurped_names imp_names
686 ((listToBag still_gated_insts), tycls_names)
687 -- NB: don't throw away tycls_names; we may comre across more instance decls
691 traceRn (sep [text "getInstDecls:", fsep (map (ppr PprDebug) (nameSetToList tycls_names))]) `thenRn_`
692 setIfacesRn new_ifaces `thenRn_`
693 returnRn un_gated_insts
695 load_it mod = loadInterface (doc_str mod) mod False{- not as source-}
696 doc_str mod = sep [pprModule PprDebug mod, ptext SLIT("is a special-instance module")]
699 getSpecialInstModules :: RnMG [Module]
700 getSpecialInstModules
701 = getIfacesRn `thenRn` \ ifaces ->
703 Ifaces _ _ _ _ _ _ _ _ inst_mods = ifaces
709 %*********************************************************
711 \subsection{Keeping track of what we've slurped, and version numbers}
713 %*********************************************************
715 getImportVersions figures out what the "usage information" for this moudule is;
716 that is, what it must record in its interface file as the things it uses.
718 - anything reachable from its body code
719 - any module exported with a "module Foo".
721 Why the latter? Because if Foo changes then this module's export list
722 will change, so we must recompile this module at least as far as
723 making a new interface file --- but in practice that means complete
727 module A( f, g ) where module B( f ) where
728 import B( f ) f = h 3
731 Should we record B.f in A's usages? In fact we don't. Certainly, if
732 anything about B.f changes than anyone who imports A should be recompiled;
733 they'll get an early exit if they don't use B.f. However, even if B.f
734 doesn't change at all, B.h may do so, and this change may not be reflected
735 in f's version number. So there are two things going on when compiling module A:
737 1. Are A.o and A.hi correct? Then we can bale out early.
738 2. Should modules that import A be recompiled?
740 For (1) it is slightly harmful to record B.f in A's usages, because a change in
741 B.f's version will provoke full recompilation of A, producing an identical A.o,
742 and A.hi differing only in its usage-version of B.f (which isn't used by any importer).
744 For (2), because of the tricky B.h question above, we ensure that A.hi is touched
745 (even if identical to its previous version) if A's recompilation was triggered by
746 an imported .hi file date change. Given that, there's no need to record B.f in
749 On the other hand, if A exports "module B" then we *do* count module B among
750 A's usages, because we must recompile A to ensure that A.hi changes appropriately.
753 getImportVersions :: Module -- Name of this module
754 -> Maybe [IE any] -- Export list for this module
755 -> RnMG (VersionInfo Name) -- Version info for these names
757 getImportVersions this_mod exports
758 = getIfacesRn `thenRn` \ ifaces ->
760 Ifaces _ mod_versions_map _ _ _ imp_names _ _ _ = ifaces
761 mod_version mod = expectJust "import_versions" (lookupFM mod_versions_map mod)
763 -- mv_map groups together all the things imported from a particular module.
764 mv_map, mv_map_mod :: FiniteMap Module [LocalVersion Name]
766 mv_map_mod = foldl add_mod emptyFM export_mods
767 -- mv_map_mod records all the modules that have a "module M"
768 -- in this module's export list
770 mv_map = foldl add_mv mv_map_mod imp_names
771 -- mv_map adds the version numbers of things exported individually
773 returnRn [ (mod, mod_version mod, local_versions)
774 | (mod, local_versions) <- fmToList mv_map
778 export_mods = case exports of
780 Just es -> [mod | IEModuleContents mod <- es, mod /= this_mod]
782 add_mv mv_map v@(name, version)
783 = addToFM_C (\ ls _ -> (v:ls)) mv_map mod [v]
785 mod = nameModule name
787 add_mod mv_map mod = addToFM mv_map mod []
792 = getIfacesRn `thenRn` \ (Ifaces _ _ _ _ slurped_names _ _ _ _) ->
793 returnRn (name `elemNameSet` slurped_names)
795 getSlurpedNames :: RnMG NameSet
797 = getIfacesRn `thenRn` \ ifaces ->
799 Ifaces _ _ _ _ slurped_names _ _ _ _ = ifaces
801 returnRn slurped_names
803 recordSlurp maybe_version necessity avail
804 = traceRn (hsep [text "Record slurp:", pprAvail (PprForUser opt_PprUserLength) avail,
805 -- NB PprForDebug prints export flag, which is too
806 -- strict; it's a knot-tied thing in RnNames
807 case necessity of {Compulsory -> text "comp"; Optional -> text "opt"}]) `thenRn_`
808 getIfacesRn `thenRn` \ ifaces ->
810 Ifaces this_mod mod_vers export_envs decls slurped_names imp_names (insts, tycls_names) deferred_data_decls inst_mods = ifaces
811 new_slurped_names = addAvailToNameSet slurped_names avail
813 new_imp_names = case maybe_version of
814 Just version -> (availName avail, version) : imp_names
817 -- Add to the names that will let in instance declarations;
818 -- but only (a) if it's a type/class
819 -- (b) if it's compulsory (unless the test flag opt_PruneInstDecls is off)
820 new_tycls_names = case avail of
821 AvailTC tc _ | not opt_PruneInstDecls ||
822 case necessity of {Optional -> False; Compulsory -> True }
823 -> tycls_names `addOneToNameSet` tc
824 otherwise -> tycls_names
826 new_ifaces = Ifaces this_mod mod_vers export_envs decls
829 (insts, new_tycls_names)
833 setIfacesRn new_ifaces
837 %*********************************************************
839 \subsection{Getting binders out of a declaration}
841 %*********************************************************
843 @getDeclBinders@ returns the names for a @RdrNameHsDecl@.
844 It's used for both source code (from @availsFromDecl@) and interface files
847 It doesn't deal with source-code specific things: ValD, DefD. They
848 are handled by the sourc-code specific stuff in RnNames.
851 getDeclBinders :: (RdrName -> SrcLoc -> RnMG Name) -- New-name function
855 getDeclBinders new_name (TyD (TyData _ _ tycon _ condecls _ _ src_loc))
856 = new_name tycon src_loc `thenRn` \ tycon_name ->
857 getConFieldNames new_name condecls `thenRn` \ sub_names ->
858 returnRn (AvailTC tycon_name (tycon_name : nub sub_names))
859 -- The "nub" is because getConFieldNames can legitimately return duplicates,
860 -- when a record declaration has the same field in multiple constructors
862 getDeclBinders new_name (TyD (TySynonym tycon _ _ src_loc))
863 = new_name tycon src_loc `thenRn` \ tycon_name ->
864 returnRn (AvailTC tycon_name [tycon_name])
866 getDeclBinders new_name (ClD (ClassDecl _ cname _ sigs _ _ src_loc))
867 = new_name cname src_loc `thenRn` \ class_name ->
868 mapRn (getClassOpNames new_name) sigs `thenRn` \ sub_names ->
869 returnRn (AvailTC class_name (class_name : sub_names))
871 getDeclBinders new_name (SigD (IfaceSig var ty prags src_loc))
872 = new_name var src_loc `thenRn` \ var_name ->
873 returnRn (Avail var_name)
875 getDeclBinders new_name (DefD _) = returnRn NotAvailable
876 getDeclBinders new_name (InstD _) = returnRn NotAvailable
879 getConFieldNames new_name (ConDecl con _ (RecCon fielddecls) src_loc : rest)
880 = mapRn (\n -> new_name n src_loc) (con:fields) `thenRn` \ cfs ->
881 getConFieldNames new_name rest `thenRn` \ ns ->
884 fields = concat (map fst fielddecls)
886 getConFieldNames new_name (ConDecl con _ _ src_loc : rest)
887 = new_name con src_loc `thenRn` \ n ->
888 getConFieldNames new_name rest `thenRn` \ ns ->
891 getConFieldNames new_name [] = returnRn []
893 getClassOpNames new_name (ClassOpSig op _ _ src_loc) = new_name op src_loc
897 %*********************************************************
899 \subsection{Reading an interface file}
901 %*********************************************************
904 findAndReadIface :: Doc -> Module -> RnMG (Maybe ParsedIface)
905 -- Nothing <=> file not found, or unreadable, or illegible
906 -- Just x <=> successfully found and parsed
907 findAndReadIface doc_str filename
908 = traceRn trace_msg `thenRn_`
909 getSearchPathRn `thenRn` \ dirs ->
912 trace_msg = hang (hcat [ptext SLIT("Reading interface for "),
913 ptext filename, semi])
914 4 (hcat [ptext SLIT("reason: "), doc_str])
916 try all_dirs [] = traceRn (ptext SLIT("...failed")) `thenRn_`
919 try all_dirs ((dir,hisuf):dirs)
920 = readIface file_path `thenRn` \ read_result ->
922 Nothing -> try all_dirs dirs
923 Just iface -> traceRn (ptext SLIT("...done")) `thenRn_`
924 returnRn (Just iface)
926 file_path = dir ++ '/':moduleString filename ++ hisuf
929 @readIface@ trys just one file.
932 readIface :: String -> RnMG (Maybe ParsedIface)
933 -- Nothing <=> file not found, or unreadable, or illegible
934 -- Just x <=> successfully found and parsed
936 = ioToRnMG (hGetStringBuffer file_path) `thenRn` \ read_result ->
937 --traceRn (hcat[ptext SLIT("Opening...."), text file_path]) `thenRn_`
940 case parseIface contents of
942 --traceRn (ptext SLIT("parse err")) `thenRn_`
943 failWithRn Nothing err
945 --traceRn (ptext SLIT("parse cool")) `thenRn_`
946 returnRn (Just iface)
948 #if __GLASGOW_HASKELL__ >= 202
950 if isDoesNotExistError err then
951 --traceRn (ptext SLIT("no file")) `thenRn_`
954 --traceRn (ptext SLIT("uh-oh..")) `thenRn_`
955 failWithRn Nothing (cannaeReadFile file_path err)
956 #else /* 2.01 and 0.2x */
957 Left (NoSuchThing _) -> returnRn Nothing
959 Left err -> failWithRn Nothing
960 (cannaeReadFile file_path err)
965 mkSearchPath takes a string consisting of a colon-separated list
966 of directories and corresponding suffixes, and turns it into a list
967 of (directory, suffix) pairs. For example:
970 mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
971 = [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
975 mkSearchPath :: Maybe String -> SearchPath
976 mkSearchPath Nothing = [(".",".hi")]
977 mkSearchPath (Just s)
982 case span (/= '%') s of
984 case span (/= ':') rs of
985 (hisuf,_:rest) -> (dir,hisuf):go rest
986 (hisuf,[]) -> [(dir,hisuf)]
989 %*********************************************************
993 %*********************************************************
996 noIfaceErr filename sty
997 = hcat [ptext SLIT("Could not find valid interface file "),
998 quotes (pprModule sty filename)]
999 -- , text " in"]) 4 (vcat (map text dirs))
1001 cannaeReadFile file err sty
1002 = hcat [ptext SLIT("Failed in reading file: "),
1004 ptext SLIT("; error="),
1008 = sep [ptext SLIT("Failed to find interface decl for"),
1011 getDeclWarn name sty
1012 = sep [ptext SLIT("Warning: failed to find (optional) interface decl for"),