2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[RnIfaces]{Cacheing and Renaming of Interfaces}
7 #include "HsVersions.h"
23 import PreludeGlaST ( thenPrimIO, seqPrimIO, readVar, writeVar, MutableVar(..) )
26 import HsPragmas ( noGenPragmas )
31 import RnSource ( rnTyDecl, rnClassDecl, rnInstDecl, rnPolyType )
32 import RnUtils ( RnEnv(..), emptyRnEnv, lookupRnEnv, lookupTcRnEnv, extendGlobalRnEnv )
33 import ParseIface ( parseIface )
34 import ParseUtils ( ParsedIface(..), RdrIfaceDecl(..), RdrIfaceInst(..) )
36 import Bag ( emptyBag, consBag, snocBag, unionBags, unionManyBags, isEmptyBag, bagToList )
37 import CmdLineOpts ( opt_HiSuffix, opt_SysHiSuffix )
38 import ErrUtils ( Error(..), Warning(..) )
39 import FiniteMap ( emptyFM, lookupFM, addToFM, addToFM_C, plusFM, eltsFM,
40 fmToList, delListFromFM, sizeFM, keysFM{-ToDo:rm-} )
41 import Maybes ( maybeToBool )
42 import Name ( moduleNamePair, origName, isRdrLexCon,
43 RdrName(..){-instance NamedThing-}
45 import PprStyle -- ToDo:rm
46 import Outputable -- ToDo:rm
47 import PrelInfo ( builtinNameInfo )
49 import Maybes ( MaybeErr(..) )
50 import UniqFM ( emptyUFM )
51 import UniqSupply ( splitUniqSupply )
52 import Util ( sortLt, removeDups, cmpPString, startsWith,
53 panic, pprPanic, assertPanic, pprTrace{-ToDo:rm-} )
57 type ModuleToIfaceContents = FiniteMap Module ParsedIface
58 type ModuleToIfaceFilePath = FiniteMap Module FilePath
61 = MutableVar _RealWorld (ModuleToIfaceContents,
62 ModuleToIfaceFilePath)
65 *********************************************************
67 \subsection{Looking for interface files}
69 *********************************************************
71 Return a mapping from module-name to
72 absolute-filename-for-that-interface.
74 findHiFiles :: [FilePath] -> [FilePath] -> IO (FiniteMap Module FilePath)
76 findHiFiles dirs sysdirs
77 = hPutStr stderr " findHiFiles " >>
78 do_dirs emptyFM (dirs ++ sysdirs) >>= \ result ->
79 hPutStr stderr " done\n" >>
82 do_dirs env [] = return env
83 do_dirs env (dir:dirs)
84 = do_dir env dir >>= \ new_env ->
88 = hPutStr stderr "D" >>
89 getDirectoryContents dir >>= \ entries ->
90 do_entries env entries
92 do_entries env [] = return env
94 = do_entry env e >>= \ new_env ->
98 = case (acceptable_hi (reverse e)) of
99 Nothing -> --trace ("Deemed uncool:"++e) $
100 hPutStr stderr "." >>
106 case (lookupFM env pmod) of
107 Nothing -> --trace ("Adding "++mod++" -> "++e) $
108 hPutStr stderr "!" >>
109 return (addToFM env pmod (dir ++ '/':e))
110 -- ToDo: use DIR_SEP, not /
112 Just xx -> ( if de_dot xx /= e then trace ("Already mapped!! "++mod++" -> "++xx++"; ignoring:"++e) else id) $
113 hPutStr stderr "." >>
116 acceptable_hi rev_e -- looking at pathname *backwards*
117 = case (startsWith (reverse opt_HiSuffix) rev_e) of
119 Just xs -> plausible_modname xs{-reversed-}
122 de_dot ('.' : '/' : xs) = xs
126 plausible_modname rev_e
128 cand = reverse (takeWhile is_modname_char rev_e)
130 if null cand || not (isUpper (head cand))
134 is_modname_char c = isAlphanum c || c == '_'
137 *********************************************************
139 \subsection{Reading interface files}
141 *********************************************************
143 Return cached info about a Module's interface; otherwise,
144 read the interface (using our @ModuleToIfaceFilePath@ map
145 to decide where to look).
148 cachedIface :: IfaceCache
150 -> IO (MaybeErr ParsedIface Error)
152 cachedIface iface_cache mod
153 = readVar iface_cache `thenPrimIO` \ (iface_fm, file_fm) ->
155 case (lookupFM iface_fm mod) of
156 Just iface -> return (Succeeded iface)
158 case (lookupFM file_fm mod) of
159 Nothing -> return (Failed (noIfaceErr mod))
161 readIface file mod >>= \ read_iface ->
163 Failed err -> -- pprTrace "module-file map:\n" (ppAboves [ppCat [ppPStr m, ppStr f] | (m,f) <- fmToList file_fm]) $
167 iface_fm' = addToFM iface_fm mod iface
169 writeVar iface_cache (iface_fm', file_fm) `seqPrimIO`
170 return (Succeeded iface)
173 cachedDecl :: IfaceCache
174 -> Bool -- True <=> tycon or class name
176 -> IO (MaybeErr RdrIfaceDecl Error)
178 -- ToDo: this is where the check for Prelude.map being
179 -- located in PreludeList.map should be done ...
181 cachedDecl iface_cache class_or_tycon orig
182 = cachedIface iface_cache mod >>= \ maybe_iface ->
184 Failed err -> return (Failed err)
185 Succeeded (ParsedIface _ _ _ _ exps _ _ tdefs vdefs _ _) ->
186 case (lookupFM (if class_or_tycon then tdefs else vdefs) str) of
187 Just decl -> return (Succeeded decl)
188 Nothing -> return (Failed (noDeclInIfaceErr mod str))
190 (mod, str) = moduleNamePair orig
193 cachedDeclByType :: IfaceCache
194 -> RnName{-NB: diff type than cachedDecl -}
195 -> IO (MaybeErr RdrIfaceDecl Error)
197 cachedDeclByType iface_cache rn
198 -- the idea is: check that, e.g., if we're given an
199 -- RnClass, then we really get back a ClassDecl from
200 -- the cache (not an RnData, or something silly)
201 = cachedDecl iface_cache (isRnTyConOrClass rn) (origName rn) >>= \ maybe_decl ->
203 return_maybe_decl = return maybe_decl
204 return_failed msg = return (Failed msg)
207 Failed _ -> return_maybe_decl
210 WiredInId _ -> return_failed (ifaceLookupWiredErr "value" rn)
211 WiredInTyCon _ -> return_failed (ifaceLookupWiredErr "type constructor" rn)
212 RnUnbound _ -> pprPanic "cachedDeclByType:" (ppr PprDebug rn)
214 RnSyn _ -> return_maybe_decl
215 RnData _ _ _ -> return_maybe_decl
216 RnImplicitTyCon _ -> if is_tycon_decl if_decl
217 then return_maybe_decl
218 else return_failed (badIfaceLookupErr "type constructor" rn if_decl)
220 RnClass _ _ -> return_maybe_decl
221 RnImplicitClass _ -> if is_class_decl if_decl
222 then return_maybe_decl
223 else return_failed (badIfaceLookupErr "class" rn if_decl)
225 RnName _ -> return_maybe_decl
226 RnConstr _ _ -> return_maybe_decl
227 RnField _ _ -> return_maybe_decl
228 RnClassOp _ _ -> return_maybe_decl
229 RnImplicit _ -> if is_val_decl if_decl
230 then return_maybe_decl
231 else return_failed (badIfaceLookupErr "value" rn if_decl)
233 is_tycon_decl (TypeSig _ _ _) = True
234 is_tycon_decl (NewTypeSig _ _ _ _) = True
235 is_tycon_decl (DataSig _ _ _ _ _) = True
236 is_tycon_decl _ = False
238 is_class_decl (ClassSig _ _ _ _) = True
239 is_class_decl _ = False
241 is_val_decl (ValSig _ _ _) = True
242 is_val_decl (DataSig _ _ _ _ _) = True -- may be a constr or field
243 is_val_decl (NewTypeSig _ _ _ _) = True -- may be a constr
244 is_val_decl (ClassSig _ _ _ _) = True -- may be a method
245 is_val_decl _ = False
249 readIface :: FilePath -> Module
250 -> IO (MaybeErr ParsedIface Error)
253 = hPutStr stderr (" reading "++file) >>
254 readFile file `thenPrimIO` \ read_result ->
256 Left err -> return (Failed (cannaeReadErr file err))
257 Right contents -> hPutStr stderr " parsing" >>
258 let parsed = parseIface contents in
259 hPutStr stderr " done\n" >>
265 rnIfaces :: IfaceCache -- iface cache (mutvar)
266 -> [Module] -- directly imported modules
268 -> RnEnv -- defined (in the source) name env
269 -> RnEnv -- mentioned (in the source) name env
270 -> RenamedHsModule -- module to extend with iface decls
271 -> [RnName] -- imported names required (really the
272 -- same info as in mentioned name env)
273 -- Also, all the things we may look up
274 -- later by key (Unique).
275 -> IO (RenamedHsModule, -- extended module
276 RnEnv, -- final env (for renaming derivings)
277 ImplicitEnv, -- implicit names used (for usage info)
278 (Bag Error, Bag Warning))
280 rnIfaces iface_cache imp_mods us
281 def_env@((dqual, dunqual, dtc_qual, dtc_unqual), dstack)
282 occ_env@((qual, unqual, tc_qual, tc_unqual), stack)
283 rn_module@(HsModule modname iface_version exports imports fixities
284 typedecls typesigs classdecls instdecls instsigs
285 defdecls binds sigs src_loc)
288 pprTrace "rnIfaces:going after:" (ppCat (map (ppr PprDebug) todo)) $
290 pprTrace "rnIfaces:qual:" (ppCat [ppBesides[ppPStr m,ppChar '.',ppPStr n] | (m,n) <- keysFM qual]) $
291 pprTrace "rnIfaces:unqual:" (ppCat (map ppPStr (keysFM unqual))) $
292 pprTrace "rnIfaces:tc_qual:" (ppCat [ppBesides[ppPStr m,ppChar '.',ppPStr n] | (m,n) <- keysFM tc_qual]) $
293 pprTrace "rnIfaces:tc_unqual:" (ppCat (map ppPStr (keysFM tc_unqual))) $
295 pprTrace "rnIfaces:dqual:" (ppCat [ppBesides[ppPStr m,ppChar '.',ppPStr n] | (m,n) <- keysFM dqual]) $
296 pprTrace "rnIfaces:dunqual:" (ppCat (map ppPStr (keysFM dunqual))) $
297 pprTrace "rnIfaces:dtc_qual:" (ppCat [ppBesides[ppPStr m,ppChar '.',ppPStr n] | (m,n) <- keysFM dtc_qual]) $
298 pprTrace "rnIfaces:dtc_unqual:"(ppCat (map ppPStr (keysFM dtc_unqual))) $
301 -- do transitive closure to bring in all needed names/defns and insts:
303 decls_and_insts todo def_env occ_env empty_return us
304 >>= \ (((if_typedecls, if_classdecls, if_instdecls, if_sigs),
309 return (HsModule modname iface_version exports imports fixities
310 (typedecls ++ if_typedecls)
312 (classdecls ++ if_classdecls)
313 (instdecls ++ if_instdecls)
314 instsigs defdecls binds
321 decls_and_insts todo def_env occ_env to_return us
322 = do_decls todo -- initial batch of names to process
323 (def_env, occ_env, us1) -- init stuff down
324 to_return -- acc results
329 cacheInstModules iface_cache imp_mods >>= \ errs ->
331 do_insts decls_def_env decls_occ_env emptyRnEnv emptyFM
332 (add_errs errs decls_return) us2
334 (us1,us2) = splitUniqSupply us
336 do_insts def_env occ_env prev_env done_insts to_return us
337 | size_tc_env occ_env == size_tc_env prev_env
338 = return (to_return, occ_env)
341 = rnIfaceInstStuff iface_cache modname us1 occ_env done_insts to_return
347 do_decls new_unknowns -- new batch of names to process
348 (def_env, insts_occ_env, us2) -- init stuff down
349 insts_return -- acc results
354 do_insts decls_def_env decls_occ_env occ_env new_insts decls_return us3
356 (us1,us') = splitUniqSupply us
357 (us2,us3) = splitUniqSupply us'
359 size_tc_env ((_, _, qual, unqual), _)
360 = sizeFM qual + sizeFM unqual
363 do_decls :: [RnName] -- Names we're looking for; we keep adding/deleting
364 -- from this list; we're done when empty (nothing
365 -- more needs to be looked for)
366 -> Go_Down -- see defn below
367 -> To_Return -- accumulated result
369 RnEnv, -- extended decl env
370 RnEnv) -- extended occ env
372 do_decls to_find@[] down to_return
373 = return (to_return, defenv down, occenv down)
375 do_decls to_find@(n:ns) down to_return
376 = case (lookup_defd down n) of
377 Just _ -> -- previous processing must've found the stuff for this name;
378 -- continue with the rest:
379 -- pprTrace "do_decls:done:" (ppr PprDebug n) $
380 do_decls ns down to_return
382 Nothing -> -- OK, see what the cache has for us...
384 cachedDeclByType iface_cache n >>= \ maybe_ans ->
386 Failed err -> -- add the error, but keep going:
387 -- pprTrace "do_decls:cache error:" (ppr PprDebug n) $
388 do_decls ns down (add_err err to_return)
390 Succeeded iface_decl -> -- something needing renaming!
392 (us1, us2) = splitUniqSupply (uniqsupply down)
394 case (initRn False{-iface-} modname (occenv down) us1 (
395 setExtraRn emptyUFM{-no fixities-} $
396 rnIfaceDecl iface_decl)) of {
397 ((if_decl, if_defd, if_implicits), if_errs, if_warns) ->
399 new_unknowns = eltsFM (fst if_implicits) ++ eltsFM (snd if_implicits)
402 pprTrace "do_decls:renamed:" (ppAboves [ppr PprDebug n
403 , ppCat [ppStr "new unknowns:", interpp'SP PprDebug new_unknowns]
404 , ppCat [ppStr "defd vals:", interpp'SP PprDebug [n | (_,n) <- fst if_defd] ]
405 , ppCat [ppStr "defd tcs:", interpp'SP PprDebug [n | (_,n) <- snd if_defd] ]
408 do_decls (new_unknowns ++ ns)
409 (add_occs if_defd if_implicits $
410 new_uniqsupply us2 down)
412 add_implicits if_implicits $
414 add_warns if_warns to_return)
418 type Go_Down = (RnEnv, -- stuff we already have defns for;
419 -- to check quickly if we've already
420 -- found something for the name under consideration,
421 -- due to previous processing.
422 -- It starts off just w/ the defns for
423 -- the things in this module.
424 RnEnv, -- occurrence env; this gets added to as
425 -- we process new iface decls. It includes
426 -- entries for *all* occurrences, including those
427 -- for which we have definitions.
428 UniqSupply -- the obvious
431 lookup_defd (def_env, _, _) n
433 = lookupTcRnEnv def_env (origName n)
435 = lookupRnEnv def_env (origName n)
437 defenv (def_env, _, _) = def_env
438 occenv (_, occ_env, _) = occ_env
439 uniqsupply (_, _, us) = us
441 new_uniqsupply us (def_env, occ_env, _) = (def_env, occ_env, us)
443 add_occs (val_defds, tc_defds) (val_imps, tc_imps) (def_env, occ_env, us)
444 = case (extendGlobalRnEnv def_env val_defds tc_defds) of { (new_def_env, def_dups) ->
445 ASSERT(isEmptyBag def_dups)
447 val_occs = val_defds ++ fmToList val_imps
448 tc_occs = tc_defds ++ fmToList tc_imps
450 case (extendGlobalRnEnv occ_env val_occs tc_occs) of { (new_occ_env, occ_dups) ->
452 -- ASSERT(isEmptyBag occ_dups)
453 -- False because we may get a dup on the name we just shoved in
455 (new_def_env, new_occ_env, us) }}
458 type To_Return = (([RenamedTyDecl], [RenamedClassDecl], [RenamedInstDecl], [RenamedSig]),
459 ImplicitEnv, -- new names used implicitly
460 (Bag Error, Bag Warning)
463 empty_return :: To_Return
464 empty_return = (([],[],[],[]), emptyImplicitEnv, (emptyBag,emptyBag))
466 add_decl decl ((tydecls, classdecls, instdecls, sigs), implicit, msgs)
468 AddedTy t -> ((t:tydecls, classdecls, instdecls, sigs), implicit, msgs)
469 AddedClass c -> ((tydecls, c:classdecls, instdecls, sigs), implicit, msgs)
470 AddedSig s -> ((tydecls, classdecls, instdecls, s:sigs), implicit, msgs)
472 add_insts is ((tydecls, classdecls, instdecls, sigs), implicit, msgs)
473 = ((tydecls, classdecls, is ++ instdecls, sigs), implicit, msgs)
475 add_implicits (val_imps, tc_imps) (decls, (val_fm, tc_fm), msgs)
476 = (decls, (val_fm `plusFM` val_imps, tc_fm `plusFM` tc_imps), msgs)
478 add_err err (decls,implicit,(errs,warns)) = (decls,implicit,(errs `snocBag` err,warns))
479 add_errs ers (decls,implicit,(errs,warns)) = (decls,implicit,(errs `unionBags` ers,warns))
480 add_warns ws (decls,implicit,(errs,warns)) = (decls,implicit,(errs, warns `unionBags` ws))
484 data AddedDecl -- purely local
485 = AddedTy RenamedTyDecl
486 | AddedClass RenamedClassDecl
487 | AddedSig RenamedSig
489 rnIfaceDecl :: RdrIfaceDecl
490 -> RnM_Fixes _RealWorld
491 (AddedDecl, -- the resulting decl to add to the pot
492 ([(RdrName,RnName)], [(RdrName,RnName)]),
493 -- new val/tycon-class names that have
494 -- *been defined* while processing this decl
495 ImplicitEnv -- new implicit val/tycon-class names that we
499 rnIfaceDecl (TypeSig tc _ decl)
500 = rnTyDecl decl `thenRn` \ rn_decl ->
501 lookupTyCon tc `thenRn` \ rn_tc ->
502 getImplicitUpRn `thenRn` \ mentioned ->
504 defds = ([], [(tc, rn_tc)])
505 implicits = mentioned `sub` defds
507 returnRn (AddedTy rn_decl, defds, implicits)
509 rnIfaceDecl (NewTypeSig tc dc _ decl)
510 = rnTyDecl decl `thenRn` \ rn_decl ->
511 lookupTyCon tc `thenRn` \ rn_tc ->
512 lookupValue dc `thenRn` \ rn_dc ->
513 getImplicitUpRn `thenRn` \ mentioned ->
515 defds = ([(dc, rn_dc)], [(tc, rn_tc)])
516 implicits = mentioned `sub` defds
518 returnRn (AddedTy rn_decl, defds, implicits)
520 rnIfaceDecl (DataSig tc dcs fcs _ decl)
521 = rnTyDecl decl `thenRn` \ rn_decl ->
522 lookupTyCon tc `thenRn` \ rn_tc ->
523 mapRn lookupValue dcs `thenRn` \ rn_dcs ->
524 mapRn lookupValue fcs `thenRn` \ rn_fcs ->
525 getImplicitUpRn `thenRn` \ mentioned ->
527 defds = (zip dcs rn_dcs ++ zip fcs rn_fcs , [(tc, rn_tc)])
528 implicits = mentioned `sub` defds
530 returnRn (AddedTy rn_decl, defds, implicits)
532 rnIfaceDecl (ClassSig clas ops _ decl)
533 = rnClassDecl decl `thenRn` \ rn_decl ->
534 lookupClass clas `thenRn` \ rn_clas ->
535 mapRn (lookupClassOp rn_clas) ops `thenRn` \ rn_ops ->
536 getImplicitUpRn `thenRn` \ mentioned ->
538 defds = (ops `zip` rn_ops, [(clas, rn_clas)])
539 implicits = mentioned `sub` defds
541 returnRn (AddedClass rn_decl, defds, implicits)
543 rnIfaceDecl (ValSig f src_loc ty)
544 -- should rename_sig in RnBinds be used here? ToDo
545 = lookupValue f `thenRn` \ rn_f ->
546 -- pprTrace "rnIfaceDecl:ValSig:" (ppr PprDebug ty) $
547 rnPolyType nullTyVarNamesEnv ty `thenRn` \ rn_ty ->
548 getImplicitUpRn `thenRn` \ mentioned ->
550 defds = ([(f, rn_f)], [])
551 implicits = mentioned `sub` defds
553 returnRn (AddedSig (Sig rn_f rn_ty noGenPragmas src_loc), defds, implicits)
556 sub :: ImplicitEnv -> ([(RdrName,RnName)], [(RdrName,RnName)]) -> ImplicitEnv
558 sub (val_ment, tc_ment) (val_defds, tc_defds)
559 = (delListFromFM val_ment (map fst val_defds),
560 delListFromFM tc_ment (map fst tc_defds))
563 % ------------------------------
565 @cacheInstModules@: cache instance modules specified in imports
568 cacheInstModules :: IfaceCache -> [Module] -> IO (Bag Error)
569 cacheInstModules iface_cache imp_mods
570 = readVar iface_cache `thenPrimIO` \ (iface_fm, _) ->
572 imp_ifaces = [ iface | Just iface <- map (lookupFM iface_fm) imp_mods ]
573 (imp_imods, _) = removeDups cmpPString (bagToList (unionManyBags (map get_ims imp_ifaces)))
574 get_ims (ParsedIface _ _ _ _ _ ims _ _ _ _ _) = ims
576 accumulate (map (cachedIface iface_cache) imp_imods) >>= \ err_or_ifaces ->
579 -- Assert that instance modules given by direct imports contains
580 -- instance modules extracted from all visited modules
582 readVar iface_cache `thenPrimIO` \ (all_iface_fm, _) ->
584 all_ifaces = eltsFM all_iface_fm
585 (all_imods, _) = removeDups cmpPString (bagToList (unionManyBags (map get_ims (all_ifaces))))
587 ASSERT(sortLt (<) imp_imods == sortLt (<) all_imods)
589 return (bag_errs err_or_ifaces)
591 bag_errs [] = emptyBag
592 bag_errs (Failed err :rest) = err `consBag` bag_errs rest
593 bag_errs (Succeeded _:rest) = bag_errs rest
597 @rnIfaceInstStuff@: Deal with instance declarations from interface files.
600 type InstanceEnv = FiniteMap (RdrName, RdrName) Int
603 :: IfaceCache -- all about ifaces we've read
606 -> RnEnv -- current occ env
607 -> InstanceEnv -- instances for these tycon/class pairs done
610 InstanceEnv, -- extended instance env
611 RnEnv, -- final occ env
612 [RnName]) -- new unknown names
614 rnIfaceInstStuff iface_cache modname us occ_env done_inst_env to_return
615 = -- all the instance decls we might even want to consider
616 -- are in the ParsedIfaces that are in our cache
618 readVar iface_cache `thenPrimIO` \ (iface_fm, _) ->
620 all_ifaces = eltsFM iface_fm
621 all_insts = unionManyBags (map get_insts all_ifaces)
622 interesting_insts = filter want_inst (bagToList all_insts)
625 -- Assert that there are no more instances for the done instances
627 claim_done = filter is_done_inst (bagToList all_insts)
628 claim_done_env = foldr add_done_inst emptyFM claim_done
629 has_val fm (k,i) = case lookupFM fm k of { Nothing -> False; Just v -> i == v }
632 pprTrace "all_insts:\n" (ppr_insts (bagToList all_insts)) $
633 pprTrace "interesting_insts:\n" (ppr_insts interesting_insts) $
635 ASSERT(sizeFM done_inst_env == sizeFM claim_done_env)
636 ASSERT(all (has_val claim_done_env) (fmToList done_inst_env))
638 case (initRn False{-iface-} modname occ_env us (
639 setExtraRn emptyUFM{-no fixities-} $
640 mapRn rnIfaceInst interesting_insts `thenRn` \ insts ->
641 getImplicitUpRn `thenRn` \ implicits ->
642 returnRn (insts, implicits))) of {
643 ((if_insts, if_implicits), if_errs, if_warns) ->
645 return (add_insts if_insts $
646 add_implicits if_implicits $
648 add_warns if_warns to_return,
649 foldr add_done_inst done_inst_env interesting_insts,
650 add_imp_occs if_implicits occ_env,
651 eltsFM (fst if_implicits) ++ eltsFM (snd if_implicits))
654 get_insts (ParsedIface _ _ _ _ _ _ _ _ _ insts _) = insts
656 add_done_inst (InstSig clas tycon _ _) inst_env
657 = addToFM_C (+) inst_env (tycon,clas) 1
659 is_done_inst (InstSig clas tycon _ _)
660 = maybeToBool (lookupFM done_inst_env (tycon,clas))
662 add_imp_occs (val_imps, tc_imps) occ_env
663 = case extendGlobalRnEnv occ_env (fmToList val_imps) (fmToList tc_imps) of
664 (ext_occ_env, occ_dups) -> ASSERT(isEmptyBag occ_dups)
667 want_inst i@(InstSig clas tycon _ _)
668 = -- it's a "good instance" (one to hang onto) if we have a
669 -- chance of referring to *both* the class and tycon later on ...
671 mentionable tycon && mentionable clas && not (is_done_inst i)
674 = case lookupTcRnEnv occ_env nm of
676 Nothing -> -- maybe it's builtin
680 case (lookupFM b_tc_names n) of
682 Nothing -> maybeToBool (lookupFM b_keys n)
684 (b_tc_names, b_keys) -- pretty UGLY ...
685 = case builtinNameInfo of ((_,builtin_tcs),b_keys,_) -> (builtin_tcs,b_keys)
688 = ppAboves (map ppr_inst insts)
690 ppr_inst (InstSig c t _ inst_decl)
691 = ppCat [ppr PprDebug c, ppr PprDebug t, ppr PprDebug inst_decl]
695 rnIfaceInst :: RdrIfaceInst -> RnM_Fixes _RealWorld RenamedInstDecl
697 rnIfaceInst (InstSig _ _ _ inst_decl) = rnInstDecl inst_decl
702 IfaceCache -- iface cache
703 -> [RnName] -- all imported names required
704 -> [Module] -- directly imported modules
705 -> IO (VersionInfo, -- info about version numbers
706 [Module]) -- special instance modules
708 type VersionInfo = [(Module, Version, [(FAST_STRING, Version)])]
710 finalIfaceInfo iface_cache imps_reqd imp_mods
717 = ppCat [ppPStr SLIT("Could not find interface for:"), ppPStr mod]
719 noDeclInIfaceErr mod str sty
720 = ppBesides [ppPStr SLIT("Could not find interface declaration of: "),
721 ppPStr mod, ppStr ".", ppPStr str]
723 cannaeReadErr file err sty
724 = ppBesides [ppPStr SLIT("Failed in reading file: "), ppStr file, ppStr "; error=", ppStr (show err)]
726 ifaceLookupWiredErr msg n sty
727 = ppBesides [ppPStr SLIT("Why am I looking up a wired-in "), ppStr msg, ppChar ':', ppr sty n]
729 badIfaceLookupErr msg name decl sty
730 = ppBesides [ppPStr SLIT("Expected a "), ppStr msg, ppPStr SLIT(" declaration, but got this: ???")]