2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[RnSource]{Main pass of renamer}
7 #include "HsVersions.h"
9 module RnSource ( rnSource, rnTyDecl, rnClassDecl, rnInstDecl, rnPolyType ) where
12 import RnLoop -- *check* the RnPass/RnExpr/RnBinds loop-breaking
19 import RnBinds ( rnTopBinds, rnMethodBinds )
20 import RnUtils ( lubExportFlag )
22 import Bag ( emptyBag, unitBag, consBag, unionManyBags, unionBags, listToBag, bagToList )
23 import Class ( derivableClassKeys )
24 import FiniteMap ( emptyFM, lookupFM, addListToFM_C )
25 import ListSetOps ( unionLists, minusList )
26 import Maybes ( maybeToBool, catMaybes )
27 import Name ( Name, isLocallyDefined, isLexVarId, getLocalName, ExportFlag(..),
28 nameImportFlag, RdrName, pprNonSym )
29 import Outputable -- ToDo:rm
30 import PprStyle -- ToDo:rm
32 import SrcLoc ( SrcLoc )
33 import Unique ( Unique )
34 import UniqFM ( emptyUFM, addListToUFM, addListToUFM_C, listToUFM, lookupUFM, eltsUFM )
35 import UniqSet ( UniqSet(..) )
36 import Util ( isIn, isn'tIn, sortLt, removeDups, cmpPString, panic, assertPanic, pprTrace{-ToDo:rm-} )
39 rnSource `renames' the source module and export list.
40 It simultaneously performs dependency analysis and precedence parsing.
41 It also does the following error checks:
44 Checks that tyvars are used properly. This includes checking
45 for undefined tyvars, and tyvars in contexts that are ambiguous.
47 Checks that all variable occurences are defined.
49 Checks the (..) etc constraints in the export list.
55 -> Bag (Module,RnName) -- unqualified imports from module
56 -> Bag RenamedFixityDecl -- fixity info for imported names
58 -> RnM s (RenamedHsModule,
59 Name -> ExportFlag, -- export info
60 Bag (RnName, RdrName)) -- occurrence info
62 rnSource imp_mods unqual_imps imp_fixes
63 (HsModule mod version exports _ fixes
64 ty_decls specdata_sigs class_decls
65 inst_decls specinst_sigs defaults
68 = pushSrcLocRn src_loc $
70 rnExports (mod:imp_mods) unqual_imps exports `thenRn` \ exported_fn ->
71 rnFixes fixes `thenRn` \ src_fixes ->
73 pair_name inf@(InfixL n _) = (n, inf)
74 pair_name inf@(InfixR n _) = (n, inf)
75 pair_name inf@(InfixN n _) = (n, inf)
77 imp_fixes_fm = listToUFM (map pair_name (bagToList imp_fixes))
78 all_fixes_fm = addListToUFM imp_fixes_fm (map pair_name src_fixes)
80 setExtraRn all_fixes_fm $
82 mapRn rnTyDecl ty_decls `thenRn` \ new_ty_decls ->
83 mapRn rnSpecDataSig specdata_sigs `thenRn` \ new_specdata_sigs ->
84 mapRn rnClassDecl class_decls `thenRn` \ new_class_decls ->
85 mapRn rnInstDecl inst_decls `thenRn` \ new_inst_decls ->
86 mapRn rnSpecInstSig specinst_sigs `thenRn` \ new_specinst_sigs ->
87 rnDefaultDecl defaults `thenRn` \ new_defaults ->
88 rnTopBinds binds `thenRn` \ new_binds ->
90 getOccurrenceUpRn `thenRn` \ occ_info ->
94 trashed_exports trashed_imports src_fixes
95 new_ty_decls new_specdata_sigs new_class_decls
96 new_inst_decls new_specinst_sigs new_defaults
102 trashed_exports = {-trace "rnSource:trashed_exports"-} Nothing
103 trashed_imports = {-trace "rnSource:trashed_imports"-} []
107 %*********************************************************
109 \subsection{Export list}
111 %*********************************************************
114 rnExports :: [Module]
115 -> Bag (Module,RnName)
117 -> RnM s (Name -> ExportFlag)
119 rnExports mods unqual_imps Nothing
120 = returnRn (\n -> if isLocallyDefined n then ExportAll else NotExported)
122 rnExports mods unqual_imps (Just exps)
123 = mapAndUnzipRn (rnIE mods) exps `thenRn` \ (mod_maybes, exp_bags) ->
125 exp_names = bagToList (unionManyBags exp_bags)
126 exp_mods = catMaybes mod_maybes
128 -- Warn for duplicate names and modules
129 (uniq_exp_names, dup_names) = removeDups cmp_fst exp_names
130 (uniq_exp_mods, dup_mods) = removeDups cmpPString exp_mods
131 cmp_fst (x,_) (y,_) = x `cmp` y
133 -- Build finite map of exported names to export flag
134 exp_map0 = addListToUFM_C lub_expflag emptyUFM (map pair_fst uniq_exp_names)
135 exp_map1 = foldl add_mod_names exp_map0 uniq_exp_mods
137 mod_fm = addListToFM_C unionBags emptyFM
138 [(mod, unitBag (getName rn, nameImportFlag (getName rn)))
139 | (mod,rn) <- bagToList unqual_imps]
141 add_mod_names exp_map mod
142 = case lookupFM mod_fm mod of
144 Just mod_names -> addListToUFM_C lub_expflag exp_map (map pair_fst (bagToList mod_names))
146 pair_fst p@(f,_) = (f,p)
147 lub_expflag (n, flag1) (_, flag2) = (n, lubExportFlag flag1 flag2)
149 -- Check for exporting of duplicate local names
150 exp_locals = [(getLocalName n, n) | (n,_) <- eltsUFM exp_map1]
151 (_, dup_locals) = removeDups cmp_local exp_locals
152 cmp_local (x,_) (y,_) = x `cmpPString` y
155 -- Build export flag function
156 exp_fn n = case lookupUFM exp_map1 n of
157 Nothing -> NotExported
158 Just (_,flag) -> flag
160 getSrcLocRn `thenRn` \ src_loc ->
161 mapRn (addWarnRn . dupNameExportWarn src_loc) dup_names `thenRn_`
162 mapRn (addWarnRn . dupModuleExportWarn src_loc) dup_mods `thenRn_`
163 mapRn (addErrRn . dupLocalsExportErr src_loc) dup_locals `thenRn_`
167 rnIE mods (IEVar name)
168 = lookupValue name `thenRn` \ rn ->
169 checkIEVar rn `thenRn` \ exps ->
170 returnRn (Nothing, exps)
172 checkIEVar (RnName n) = returnRn (unitBag (n,ExportAll))
173 checkIEVar (RnUnbound _) = returnRn emptyBag
174 checkIEVar rn@(RnClassOp _ _) = getSrcLocRn `thenRn` \ src_loc ->
175 failButContinueRn emptyBag (classOpExportErr rn src_loc)
176 checkIEVar rn = panic "checkIEVar"
178 rnIE mods (IEThingAbs name)
179 = lookupTyConOrClass name `thenRn` \ rn ->
180 checkIEAbs rn `thenRn` \ exps ->
181 returnRn (Nothing, exps)
183 checkIEAbs (RnSyn n) = returnRn (unitBag (n,ExportAbs))
184 checkIEAbs (RnData n _) = returnRn (unitBag (n,ExportAbs))
185 checkIEAbs (RnClass n _) = returnRn (unitBag (n,ExportAbs))
186 checkIEAbs (RnUnbound _) = returnRn emptyBag
187 checkIEAbs rn = panic "checkIEAbs"
189 rnIE mods (IEThingAll name)
190 = lookupTyConOrClass name `thenRn` \ rn ->
191 checkIEAll rn `thenRn` \ exps ->
192 checkImportAll rn `thenRn_`
193 returnRn (Nothing, exps)
195 checkIEAll (RnData n cons) = returnRn (consBag (exp_all n) (listToBag (map exp_all cons)))
196 checkIEAll (RnClass n ops) = returnRn (consBag (exp_all n) (listToBag (map exp_all ops)))
197 checkIEAll (RnUnbound _) = returnRn emptyBag
198 checkIEAll rn@(RnSyn _) = getSrcLocRn `thenRn` \ src_loc ->
199 warnAndContinueRn emptyBag (synAllExportErr rn src_loc)
200 checkIEAll rn = panic "checkIEAll"
202 exp_all n = (n, ExportAll)
204 rnIE mods (IEThingWith name names)
205 = lookupTyConOrClass name `thenRn` \ rn ->
206 mapRn lookupValue names `thenRn` \ rns ->
207 checkIEWith rn rns `thenRn` \ exps ->
208 checkImportAll rn `thenRn_`
209 returnRn (Nothing, exps)
211 checkIEWith rn@(RnData n cons) rns
212 | same_names cons rns = returnRn (consBag (exp_all n) (listToBag (map exp_all cons)))
213 | otherwise = rnWithErr "constructrs" rn cons rns
214 checkIEWith rn@(RnClass n ops) rns
215 | same_names ops rns = returnRn (consBag (exp_all n) (listToBag (map exp_all ops)))
216 | otherwise = rnWithErr "class ops" rn ops rns
217 checkIEWith (RnUnbound _) rns = returnRn emptyBag
218 checkIEWith rn@(RnSyn _) rns = getSrcLocRn `thenRn` \ src_loc ->
219 failButContinueRn emptyBag (synAllExportErr rn src_loc)
220 checkIEWith rn rns = panic "checkIEWith"
222 exp_all n = (n, ExportAll)
225 = all (not.isRnUnbound) rns &&
226 sortLt (<) (map uniqueOf has) == sortLt (<) (map uniqueOf rns)
228 rnWithErr str rn has rns
229 = getSrcLocRn `thenRn` \ src_loc ->
230 failButContinueRn emptyBag (withExportErr str rn has rns src_loc)
232 rnIE mods (IEModuleContents mod)
233 | isIn "rnIE:IEModule" mod mods
234 = returnRn (Just mod, emptyBag)
236 = getSrcLocRn `thenRn` \ src_loc ->
237 failButContinueRn (Nothing,emptyBag) (badModExportErr mod src_loc)
241 = case nameImportFlag (getName rn) of
242 ExportAll -> returnRn ()
243 exp -> getSrcLocRn `thenRn` \ src_loc ->
244 addErrRn (importAllErr rn src_loc)
247 %*********************************************************
249 \subsection{Type declarations}
251 %*********************************************************
253 @rnTyDecl@ uses the `global name function' to create a new type
254 declaration in which local names have been replaced by their original
255 names, reporting any unknown names.
257 Renaming type variables is a pain. Because they now contain uniques,
258 it is necessary to pass in an association list which maps a parsed
259 tyvar to its Name representation. In some cases (type signatures of
260 values), it is even necessary to go over the type first in order to
261 get the set of tyvars used by it, make an assoc list, and then go over
262 it again to rename the tyvars! However, we can also do some scoping
263 checks at the same time.
266 rnTyDecl :: RdrNameTyDecl -> RnM_Fixes s RenamedTyDecl
268 rnTyDecl (TyData context tycon tyvars condecls derivings pragmas src_loc)
269 = pushSrcLocRn src_loc $
270 lookupTyCon tycon `thenRn` \ tycon' ->
271 mkTyVarNamesEnv src_loc tyvars `thenRn` \ (tv_env, tyvars') ->
272 rnContext tv_env context `thenRn` \ context' ->
273 rnConDecls tv_env condecls `thenRn` \ condecls' ->
274 rn_derivs tycon' src_loc derivings `thenRn` \ derivings' ->
275 ASSERT(isNoDataPragmas pragmas)
276 returnRn (TyData context' tycon' tyvars' condecls' derivings' noDataPragmas src_loc)
278 rnTyDecl (TyNew context tycon tyvars condecl derivings pragmas src_loc)
279 = pushSrcLocRn src_loc $
280 lookupTyCon tycon `thenRn` \ tycon' ->
281 mkTyVarNamesEnv src_loc tyvars `thenRn` \ (tv_env, tyvars') ->
282 rnContext tv_env context `thenRn` \ context' ->
283 rnConDecls tv_env condecl `thenRn` \ condecl' ->
284 rn_derivs tycon' src_loc derivings `thenRn` \ derivings' ->
285 ASSERT(isNoDataPragmas pragmas)
286 returnRn (TyNew context' tycon' tyvars' condecl' derivings' noDataPragmas src_loc)
288 rnTyDecl (TySynonym name tyvars ty src_loc)
289 = pushSrcLocRn src_loc $
290 lookupTyCon name `thenRn` \ name' ->
291 mkTyVarNamesEnv src_loc tyvars `thenRn` \ (tv_env, tyvars') ->
292 rnMonoType tv_env ty `thenRn` \ ty' ->
293 returnRn (TySynonym name' tyvars' ty' src_loc)
295 rn_derivs tycon2 locn Nothing -- derivs not specified
298 rn_derivs tycon2 locn (Just ds)
299 = mapRn (rn_deriv tycon2 locn) ds `thenRn` \ derivs ->
300 returnRn (Just derivs)
302 rn_deriv tycon2 locn clas
303 = lookupClass clas `thenRn` \ clas_name ->
304 addErrIfRn (uniqueOf clas_name `not_elem` derivableClassKeys)
305 (derivingNonStdClassErr clas locn)
309 not_elem = isn'tIn "rn_deriv"
312 @rnConDecls@ uses the `global name function' to create a new
313 constructor in which local names have been replaced by their original
314 names, reporting any unknown names.
317 rnConDecls :: TyVarNamesEnv
319 -> RnM_Fixes s [RenamedConDecl]
321 rnConDecls tv_env con_decls
322 = mapRn rn_decl con_decls
324 rn_decl (ConDecl name tys src_loc)
325 = pushSrcLocRn src_loc $
326 lookupValue name `thenRn` \ new_name ->
327 mapRn rn_bang_ty tys `thenRn` \ new_tys ->
328 returnRn (ConDecl new_name new_tys src_loc)
330 rn_decl (ConOpDecl ty1 op ty2 src_loc)
331 = pushSrcLocRn src_loc $
332 lookupValue op `thenRn` \ new_op ->
333 rn_bang_ty ty1 `thenRn` \ new_ty1 ->
334 rn_bang_ty ty2 `thenRn` \ new_ty2 ->
335 returnRn (ConOpDecl new_ty1 new_op new_ty2 src_loc)
337 rn_decl (NewConDecl name ty src_loc)
338 = pushSrcLocRn src_loc $
339 lookupValue name `thenRn` \ new_name ->
340 rn_mono_ty ty `thenRn` \ new_ty ->
341 returnRn (NewConDecl new_name new_ty src_loc)
343 rn_decl (RecConDecl con fields src_loc)
344 = panic "rnConDecls:RecConDecl"
347 rn_mono_ty = rnMonoType tv_env
349 rn_bang_ty (Banged ty)
350 = rn_mono_ty ty `thenRn` \ new_ty ->
351 returnRn (Banged new_ty)
352 rn_bang_ty (Unbanged ty)
353 = rn_mono_ty ty `thenRn` \ new_ty ->
354 returnRn (Unbanged new_ty)
357 %*********************************************************
359 \subsection{SPECIALIZE data pragmas}
361 %*********************************************************
364 rnSpecDataSig :: RdrNameSpecDataSig
365 -> RnM_Fixes s RenamedSpecDataSig
367 rnSpecDataSig (SpecDataSig tycon ty src_loc)
368 = pushSrcLocRn src_loc $
370 tyvars = extractMonoTyNames is_tyvar_name ty
372 mkTyVarNamesEnv src_loc tyvars `thenRn` \ (tv_env,_) ->
373 lookupTyCon tycon `thenRn` \ tycon' ->
374 rnMonoType tv_env ty `thenRn` \ ty' ->
375 returnRn (SpecDataSig tycon' ty' src_loc)
377 is_tyvar_name n = isLexVarId (getLocalName n)
380 %*********************************************************
382 \subsection{Class declarations}
384 %*********************************************************
386 @rnClassDecl@ uses the `global name function' to create a new
387 class declaration in which local names have been replaced by their
388 original names, reporting any unknown names.
391 rnClassDecl :: RdrNameClassDecl -> RnM_Fixes s RenamedClassDecl
393 rnClassDecl (ClassDecl context cname tyvar sigs mbinds pragmas src_loc)
394 = pushSrcLocRn src_loc $
395 mkTyVarNamesEnv src_loc [tyvar] `thenRn` \ (tv_env, [tyvar']) ->
396 rnContext tv_env context `thenRn` \ context' ->
397 lookupClass cname `thenRn` \ cname' ->
398 mapRn (rn_op cname' tv_env) sigs `thenRn` \ sigs' ->
399 rnMethodBinds cname' mbinds `thenRn` \ mbinds' ->
400 ASSERT(isNoClassPragmas pragmas)
401 returnRn (ClassDecl context' cname' tyvar' sigs' mbinds' NoClassPragmas src_loc)
403 rn_op clas tv_env (ClassOpSig op ty pragmas locn)
404 = pushSrcLocRn locn $
405 lookupClassOp clas op `thenRn` \ op_name ->
406 rnPolyType tv_env ty `thenRn` \ new_ty ->
409 *** Please check here that tyvar' appears in new_ty ***
410 *** (used to be in tcClassSig, but it's better here)
411 *** not_elem = isn'tIn "tcClassSigs"
412 *** -- Check that the class type variable is mentioned
413 *** checkTc (clas_tyvar `not_elem` extractTyVarTemplatesFromTy local_ty)
414 *** (methodTypeLacksTyVarErr clas_tyvar (_UNPK_ op_name) src_loc) `thenTc_`
417 ASSERT(isNoClassOpPragmas pragmas)
418 returnRn (ClassOpSig op_name new_ty noClassOpPragmas locn)
422 %*********************************************************
424 \subsection{Instance declarations}
426 %*********************************************************
429 @rnInstDecl@ uses the `global name function' to create a new of
430 instance declaration in which local names have been replaced by their
431 original names, reporting any unknown names.
434 rnInstDecl :: RdrNameInstDecl -> RnM_Fixes s RenamedInstDecl
436 rnInstDecl (InstDecl cname ty mbinds from_here modname uprags pragmas src_loc)
437 = pushSrcLocRn src_loc $
438 lookupClass cname `thenRn` \ cname' ->
440 rnPolyType [] ty `thenRn` \ ty' ->
441 -- [] tv_env ensures that tyvars will be foralled
443 rnMethodBinds cname' mbinds `thenRn` \ mbinds' ->
444 mapRn (rn_uprag cname') uprags `thenRn` \ new_uprags ->
446 ASSERT(isNoInstancePragmas pragmas)
447 returnRn (InstDecl cname' ty' mbinds'
448 from_here modname new_uprags noInstancePragmas src_loc)
450 rn_uprag class_name (SpecSig op ty using locn)
451 = pushSrcLocRn src_loc $
452 lookupClassOp class_name op `thenRn` \ op_name ->
453 rnPolyType nullTyVarNamesEnv ty `thenRn` \ new_ty ->
454 rn_using using `thenRn` \ new_using ->
455 returnRn (SpecSig op_name new_ty new_using locn)
457 rn_uprag class_name (InlineSig op locn)
458 = pushSrcLocRn locn $
459 lookupClassOp class_name op `thenRn` \ op_name ->
460 returnRn (InlineSig op_name locn)
462 rn_uprag class_name (DeforestSig op locn)
463 = pushSrcLocRn locn $
464 lookupClassOp class_name op `thenRn` \ op_name ->
465 returnRn (DeforestSig op_name locn)
467 rn_uprag class_name (MagicUnfoldingSig op str locn)
468 = pushSrcLocRn locn $
469 lookupClassOp class_name op `thenRn` \ op_name ->
470 returnRn (MagicUnfoldingSig op_name str locn)
475 = lookupValue v `thenRn` \ new_v ->
476 returnRn (Just new_v)
479 %*********************************************************
481 \subsection{@SPECIALIZE instance@ user-pragmas}
483 %*********************************************************
486 rnSpecInstSig :: RdrNameSpecInstSig
487 -> RnM_Fixes s RenamedSpecInstSig
489 rnSpecInstSig (SpecInstSig clas ty src_loc)
490 = pushSrcLocRn src_loc $
492 tyvars = extractMonoTyNames is_tyvar_name ty
494 mkTyVarNamesEnv src_loc tyvars `thenRn` \ (tv_env,_) ->
495 lookupClass clas `thenRn` \ new_clas ->
496 rnMonoType tv_env ty `thenRn` \ new_ty ->
497 returnRn (SpecInstSig new_clas new_ty src_loc)
500 %*********************************************************
502 \subsection{Default declarations}
504 %*********************************************************
506 @rnDefaultDecl@ uses the `global name function' to create a new set
507 of default declarations in which local names have been replaced by
508 their original names, reporting any unknown names.
511 rnDefaultDecl :: [RdrNameDefaultDecl] -> RnM_Fixes s [RenamedDefaultDecl]
513 rnDefaultDecl [] = returnRn []
514 rnDefaultDecl [DefaultDecl tys src_loc]
515 = pushSrcLocRn src_loc $
516 mapRn (rnMonoType nullTyVarNamesEnv) tys `thenRn` \ tys' ->
517 returnRn [DefaultDecl tys' src_loc]
518 rnDefaultDecl defs@(d:ds)
519 = addErrRn (dupDefaultDeclErr defs) `thenRn_`
523 %*************************************************************************
525 \subsection{Fixity declarations}
527 %*************************************************************************
530 rnFixes :: [RdrNameFixityDecl] -> RnM s [RenamedFixityDecl]
533 = mapRn rn_fixity fixities `thenRn` \ fixes_maybe ->
534 returnRn (catMaybes fixes_maybe)
536 rn_fixity fix@(InfixL name i)
537 = rn_fixity_pieces InfixL name i fix
538 rn_fixity fix@(InfixR name i)
539 = rn_fixity_pieces InfixR name i fix
540 rn_fixity fix@(InfixN name i)
541 = rn_fixity_pieces InfixN name i fix
543 rn_fixity_pieces mk_fixity name i fix
544 = lookupValueMaybe name `thenRn` \ maybe_res ->
546 Just res | isLocallyDefined res
547 -> returnRn (Just (mk_fixity res i))
548 _ -> failButContinueRn Nothing (undefinedFixityDeclErr fix)
552 %*********************************************************
554 \subsection{Support code to rename types}
556 %*********************************************************
559 rnPolyType :: TyVarNamesEnv
561 -> RnM_Fixes s RenamedPolyType
563 rnPolyType tv_env (HsForAllTy tvs ctxt ty)
564 = rn_poly_help tv_env tvs ctxt ty
566 rnPolyType tv_env (HsPreForAllTy ctxt ty)
567 = rn_poly_help tv_env forall_tyvars ctxt ty
569 mentioned_tyvars = extractCtxtTyNames ctxt `unionLists` extractMonoTyNames is_tyvar_name ty
570 forall_tyvars = --pprTrace "mentioned:" (ppCat (map (ppr PprShowAll) mentioned_tyvars)) $
571 --pprTrace "from_ty:" (ppCat (map (ppr PprShowAll) (extractMonoTyNames is_tyvar_name ty))) $
572 mentioned_tyvars `minusList` domTyVarNamesEnv tv_env
575 rn_poly_help :: TyVarNamesEnv
579 -> RnM_Fixes s RenamedPolyType
581 rn_poly_help tv_env tyvars ctxt ty
582 = --pprTrace "rnPolyType:" (ppCat [ppCat (map (ppr PprShowAll . snd) tv_env),
583 -- ppStr ";tvs=", ppCat (map (ppr PprShowAll) tyvars),
584 -- ppStr ";ctxt=", ppCat (map (ppr PprShowAll) ctxt),
585 -- ppStr ";ty=", ppr PprShowAll ty]
587 getSrcLocRn `thenRn` \ src_loc ->
588 mkTyVarNamesEnv src_loc tyvars `thenRn` \ (tv_env1, new_tyvars) ->
590 tv_env2 = catTyVarNamesEnvs tv_env1 tv_env
592 rnContext tv_env2 ctxt `thenRn` \ new_ctxt ->
593 rnMonoType tv_env2 ty `thenRn` \ new_ty ->
594 returnRn (HsForAllTy new_tyvars new_ctxt new_ty)
598 rnMonoType :: TyVarNamesEnv
600 -> RnM_Fixes s RenamedMonoType
602 rnMonoType tv_env (MonoTyVar tyvar)
603 = lookupTyVarName tv_env tyvar `thenRn` \ tyvar' ->
604 returnRn (MonoTyVar tyvar')
606 rnMonoType tv_env (MonoListTy ty)
607 = rnMonoType tv_env ty `thenRn` \ ty' ->
608 returnRn (MonoListTy ty')
610 rnMonoType tv_env (MonoFunTy ty1 ty2)
611 = andRn MonoFunTy (rnMonoType tv_env ty1)
612 (rnMonoType tv_env ty2)
614 rnMonoType tv_env (MonoTupleTy tys)
615 = mapRn (rnMonoType tv_env) tys `thenRn` \ tys' ->
616 returnRn (MonoTupleTy tys')
618 rnMonoType tv_env (MonoTyApp name tys)
620 lookup_fn = if isLexVarId (getLocalName name)
621 then lookupTyVarName tv_env
624 lookup_fn name `thenRn` \ name' ->
625 mapRn (rnMonoType tv_env) tys `thenRn` \ tys' ->
626 returnRn (MonoTyApp name' tys')
630 rnContext :: TyVarNamesEnv -> RdrNameContext -> RnM_Fixes s RenamedContext
632 rnContext tv_env ctxt
635 rn_ctxt (clas, tyvar)
636 = lookupClass clas `thenRn` \ clas_name ->
637 lookupTyVarName tv_env tyvar `thenRn` \ tyvar_name ->
638 returnRn (clas_name, tyvar_name)
643 dupNameExportWarn locn names@((n,_):_) sty
644 = ppHang (ppCat [pprNonSym sty n, ppStr "exported", ppInt (length names), ppStr "times:"])
647 dupModuleExportWarn locn mods@(mod:_) sty
648 = ppHang (ppCat [ppStr "module", ppPStr mod, ppStr "appears", ppInt (length mods), ppStr "times in export list:"])
651 dupLocalsExportErr locn locals@((str,_):_) sty
652 = ppHang (ppBesides [ppStr "Exported names have same local name `", ppPStr str, ppStr "': ", ppr sty locn])
653 4 (ppInterleave ppSP (map (pprNonSym sty . snd) locals))
655 classOpExportErr op locn sty
656 = ppHang (ppStr "Class operation can only be exported with class:")
657 4 (ppCat [ppr sty op, ppr sty locn])
659 synAllExportErr syn locn sty
660 = ppHang (ppStr "Type synonym should be exported abstractly:")
661 4 (ppCat [ppr sty syn, ppr sty locn])
663 withExportErr str rn has rns locn sty
664 = ppHang (ppBesides [ppStr "Inconsistent list of ", ppStr str, ppStr ": ", ppr sty locn])
665 4 (ppAbove (ppCat [ppStr "expected:", ppInterleave ppComma (map (ppr sty) has)])
666 (ppCat [ppStr "found: ", ppInterleave ppComma (map (ppr sty) rns)]))
668 importAllErr rn locn sty
669 = ppHang (ppCat [pprNonSym sty rn, ppStr "exported concretely but only imported abstractly"])
672 badModExportErr mod locn sty
673 = ppHang (ppStr "Unknown module in export list:")
674 4 (ppCat [ppStr "module", ppPStr mod, ppr sty locn])
676 derivingNonStdClassErr clas locn sty
677 = ppHang (ppStr "Non-standard class in deriving:")
678 4 (ppCat [ppr sty clas, ppr sty locn])
680 dupDefaultDeclErr defs sty
681 = ppHang (ppStr "Duplicate default declarations:")
682 4 (ppAboves (map pp_def_loc defs))
684 pp_def_loc (DefaultDecl _ src_loc) = ppr sty src_loc
686 undefinedFixityDeclErr decl sty
687 = ppHang (ppStr "Fixity declaration for unknown operator:")