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 ( lookupGlobalRnEnv, lubExportFlag )
22 import Bag ( emptyBag, unitBag, consBag, unionManyBags, unionBags, listToBag, bagToList )
23 import Class ( derivableClassKeys )
24 import ErrUtils ( addErrLoc, addShortErrLocLine )
25 import FiniteMap ( emptyFM, lookupFM, addListToFM_C )
26 import ListSetOps ( unionLists, minusList )
27 import Maybes ( maybeToBool, catMaybes )
28 import Name ( Name, isLocallyDefined, isLexVarId, getLocalName, ExportFlag(..),
29 nameImportFlag, RdrName, pprNonSym )
30 import Outputable -- ToDo:rm
31 import PprStyle -- ToDo:rm
33 import SrcLoc ( SrcLoc )
34 import Unique ( Unique )
35 import UniqFM ( emptyUFM, addListToUFM_C, listToUFM, lookupUFM, eltsUFM )
36 import UniqSet ( UniqSet(..) )
37 import Util ( isIn, isn'tIn, sortLt, removeDups, cmpPString, assertPanic, pprTrace{-ToDo:rm-} )
40 rnSource `renames' the source module and export list.
41 It simultaneously performs dependency analysis and precedence parsing.
42 It also does the following error checks:
45 Checks that tyvars are used properly. This includes checking
46 for undefined tyvars, and tyvars in contexts that are ambiguous.
48 Checks that all variable occurences are defined.
50 Checks the (..) etc constraints in the export list.
56 -> Bag (Module,RnName) -- unqualified imports from module
57 -> Bag RenamedFixityDecl -- fixity info for imported names
59 -> RnM s (RenamedHsModule,
60 Name -> ExportFlag, -- export info
61 Bag (RnName, RdrName)) -- occurrence info
63 rnSource imp_mods unqual_imps imp_fixes
64 (HsModule mod version exports _ fixes
65 ty_decls specdata_sigs class_decls
66 inst_decls specinst_sigs defaults
69 = pushSrcLocRn src_loc $
71 rnExports (mod:imp_mods) unqual_imps exports `thenRn` \ exported_fn ->
72 rnFixes fixes `thenRn` \ src_fixes ->
74 pair_name inf = (nameFixDecl inf, inf)
76 all_fixes = src_fixes ++ bagToList imp_fixes
77 all_fixes_fm = listToUFM (map pair_name all_fixes)
79 setExtraRn all_fixes_fm $
81 mapRn rnTyDecl ty_decls `thenRn` \ new_ty_decls ->
82 mapRn rnSpecDataSig specdata_sigs `thenRn` \ new_specdata_sigs ->
83 mapRn rnClassDecl class_decls `thenRn` \ new_class_decls ->
84 mapRn rnInstDecl inst_decls `thenRn` \ new_inst_decls ->
85 mapRn rnSpecInstSig specinst_sigs `thenRn` \ new_specinst_sigs ->
86 rnDefaultDecl defaults `thenRn` \ new_defaults ->
87 rnTopBinds binds `thenRn` \ new_binds ->
89 getOccurrenceUpRn `thenRn` \ occ_info ->
93 trashed_exports trashed_imports all_fixes
94 new_ty_decls new_specdata_sigs new_class_decls
95 new_inst_decls new_specinst_sigs new_defaults
101 trashed_exports = {-trace "rnSource:trashed_exports"-} Nothing
102 trashed_imports = {-trace "rnSource:trashed_imports"-} []
106 %*********************************************************
108 \subsection{Export list}
110 %*********************************************************
113 rnExports :: [Module]
114 -> Bag (Module,RnName)
116 -> RnM s (Name -> ExportFlag)
118 rnExports mods unqual_imps Nothing
119 = returnRn (\n -> if isLocallyDefined n then ExportAll else NotExported)
121 rnExports mods unqual_imps (Just exps)
122 = mapAndUnzipRn (rnIE mods) exps `thenRn` \ (mod_maybes, exp_bags) ->
124 exp_names = bagToList (unionManyBags exp_bags)
125 exp_mods = catMaybes mod_maybes
127 -- Warn for duplicate names and modules
128 (uniq_exp_names, dup_names) = removeDups cmp_fst exp_names
129 (uniq_exp_mods, dup_mods) = removeDups cmpPString exp_mods
130 cmp_fst (x,_) (y,_) = x `cmp` y
132 -- Build finite map of exported names to export flag
133 exp_map0 = addListToUFM_C lub_expflag emptyUFM (map pair_fst uniq_exp_names)
134 (exp_map1, empty_mods) = foldl add_mod_names (exp_map0, []) uniq_exp_mods
136 mod_fm = addListToFM_C unionBags emptyFM
137 [(mod, unitBag (getName rn, nameImportFlag (getName rn)))
138 | (mod,rn) <- bagToList unqual_imps]
140 add_mod_names (exp_map, empty) mod
141 = case lookupFM mod_fm mod of
142 Nothing -> (exp_map, mod:empty)
143 Just mod_names -> (addListToUFM_C lub_expflag exp_map (map pair_fst (bagToList mod_names)), empty)
145 pair_fst p@(f,_) = (f,p)
146 lub_expflag (n, flag1) (_, flag2) = (n, lubExportFlag flag1 flag2)
148 -- Check for exporting of duplicate local names
149 exp_locals = [(getLocalName n, n) | (n,_) <- eltsUFM exp_map1]
150 (_, dup_locals) = removeDups cmp_local exp_locals
151 cmp_local (x,_) (y,_) = x `cmpPString` y
153 -- Build export flag function
154 exp_fn n = case lookupUFM exp_map1 n of
155 Nothing -> NotExported
156 Just (_,flag) -> flag
158 getSrcLocRn `thenRn` \ src_loc ->
159 mapRn (addWarnRn . dupNameExportWarn src_loc) dup_names `thenRn_`
160 mapRn (addWarnRn . dupModExportWarn src_loc) dup_mods `thenRn_`
161 mapRn (addWarnRn . emptyModExportWarn src_loc) empty_mods `thenRn_`
162 mapRn (addErrRn . dupLocalsExportErr src_loc) dup_locals `thenRn_`
166 rnIE mods (IEVar name)
167 = lookupValue name `thenRn` \ rn ->
168 checkIEVar rn `thenRn` \ exps ->
169 returnRn (Nothing, exps)
171 checkIEVar (RnName n) = returnRn (unitBag (n,ExportAll))
172 checkIEVar rn@(RnClassOp _ _) = getSrcLocRn `thenRn` \ src_loc ->
173 failButContinueRn emptyBag (classOpExportErr rn src_loc)
174 checkIEVar rn = returnRn emptyBag
176 rnIE mods (IEThingAbs name)
177 = lookupTyConOrClass name `thenRn` \ rn ->
178 checkIEAbs rn `thenRn` \ exps ->
179 returnRn (Nothing, exps)
181 checkIEAbs (RnSyn n) = returnRn (unitBag (n,ExportAbs))
182 checkIEAbs (RnData n _ _) = returnRn (unitBag (n,ExportAbs))
183 checkIEAbs (RnClass n _) = returnRn (unitBag (n,ExportAbs))
184 checkIEAbs rn = returnRn emptyBag
186 rnIE mods (IEThingAll name)
187 = lookupTyConOrClass name `thenRn` \ rn ->
188 checkIEAll rn `thenRn` \ exps ->
189 checkImportAll rn `thenRn_`
190 returnRn (Nothing, exps)
192 checkIEAll (RnData n cons fields) = returnRn (exp_all n `consBag` listToBag (map exp_all cons)
193 `unionBags` listToBag (map exp_all fields))
194 checkIEAll (RnClass n ops) = returnRn (exp_all n `consBag` listToBag (map exp_all ops))
195 checkIEAll rn@(RnSyn _) = getSrcLocRn `thenRn` \ src_loc ->
196 warnAndContinueRn emptyBag (synAllExportErr rn src_loc)
197 checkIEAll rn = returnRn emptyBag
199 exp_all n = (n, ExportAll)
201 rnIE mods (IEThingWith name names)
202 = lookupTyConOrClass name `thenRn` \ rn ->
203 mapRn lookupValue names `thenRn` \ rns ->
204 checkIEWith rn rns `thenRn` \ exps ->
205 checkImportAll rn `thenRn_`
206 returnRn (Nothing, exps)
208 checkIEWith rn@(RnData n cons fields) rns
209 | same_names (cons++fields) rns
210 = returnRn (consBag (exp_all n) (listToBag (map exp_all cons)))
212 = rnWithErr "constructrs (and fields)" rn (cons++fields) rns
213 checkIEWith rn@(RnClass n ops) rns
215 = returnRn (consBag (exp_all n) (listToBag (map exp_all ops)))
217 = rnWithErr "class ops" rn ops rns
218 checkIEWith rn@(RnSyn _) rns
219 = getSrcLocRn `thenRn` \ src_loc ->
220 failButContinueRn emptyBag (synAllExportErr rn src_loc)
224 exp_all n = (n, ExportAll)
227 = all (not.isRnUnbound) rns &&
228 sortLt (<) (map uniqueOf has) == sortLt (<) (map uniqueOf rns)
230 rnWithErr str rn has rns
231 = getSrcLocRn `thenRn` \ src_loc ->
232 failButContinueRn emptyBag (withExportErr str rn has rns src_loc)
234 rnIE mods (IEModuleContents mod)
235 | isIn "rnIE:IEModule" mod mods
236 = returnRn (Just mod, emptyBag)
238 = getSrcLocRn `thenRn` \ src_loc ->
239 failButContinueRn (Nothing,emptyBag) (badModExportErr mod src_loc)
243 = case nameImportFlag (getName rn) of
244 ExportAll -> returnRn ()
245 exp -> getSrcLocRn `thenRn` \ src_loc ->
246 addErrRn (importAllErr rn src_loc)
249 %*********************************************************
251 \subsection{Type declarations}
253 %*********************************************************
255 @rnTyDecl@ uses the `global name function' to create a new type
256 declaration in which local names have been replaced by their original
257 names, reporting any unknown names.
259 Renaming type variables is a pain. Because they now contain uniques,
260 it is necessary to pass in an association list which maps a parsed
261 tyvar to its Name representation. In some cases (type signatures of
262 values), it is even necessary to go over the type first in order to
263 get the set of tyvars used by it, make an assoc list, and then go over
264 it again to rename the tyvars! However, we can also do some scoping
265 checks at the same time.
268 rnTyDecl :: RdrNameTyDecl -> RnM_Fixes s RenamedTyDecl
270 rnTyDecl (TyData context tycon tyvars condecls derivings pragmas src_loc)
271 = pushSrcLocRn src_loc $
272 lookupTyCon tycon `thenRn` \ tycon' ->
273 mkTyVarNamesEnv src_loc tyvars `thenRn` \ (tv_env, tyvars') ->
274 rnContext tv_env context `thenRn` \ context' ->
275 rnConDecls tv_env condecls `thenRn` \ condecls' ->
276 rn_derivs tycon' src_loc derivings `thenRn` \ derivings' ->
277 ASSERT(isNoDataPragmas pragmas)
278 returnRn (TyData context' tycon' tyvars' condecls' derivings' noDataPragmas src_loc)
280 rnTyDecl (TyNew context tycon tyvars condecl derivings pragmas src_loc)
281 = pushSrcLocRn src_loc $
282 lookupTyCon tycon `thenRn` \ tycon' ->
283 mkTyVarNamesEnv src_loc tyvars `thenRn` \ (tv_env, tyvars') ->
284 rnContext tv_env context `thenRn` \ context' ->
285 rnConDecls tv_env condecl `thenRn` \ condecl' ->
286 rn_derivs tycon' src_loc derivings `thenRn` \ derivings' ->
287 ASSERT(isNoDataPragmas pragmas)
288 returnRn (TyNew context' tycon' tyvars' condecl' derivings' noDataPragmas src_loc)
290 rnTyDecl (TySynonym name tyvars ty src_loc)
291 = pushSrcLocRn src_loc $
292 lookupTyCon name `thenRn` \ name' ->
293 mkTyVarNamesEnv src_loc tyvars `thenRn` \ (tv_env, tyvars') ->
294 rnMonoType tv_env ty `thenRn` \ ty' ->
295 returnRn (TySynonym name' tyvars' ty' src_loc)
297 rn_derivs tycon2 locn Nothing -- derivs not specified
300 rn_derivs tycon2 locn (Just ds)
301 = mapRn (rn_deriv tycon2 locn) ds `thenRn` \ derivs ->
302 returnRn (Just derivs)
304 rn_deriv tycon2 locn clas
305 = lookupClass clas `thenRn` \ clas_name ->
306 addErrIfRn (uniqueOf clas_name `not_elem` derivableClassKeys)
307 (derivingNonStdClassErr clas locn)
311 not_elem = isn'tIn "rn_deriv"
314 @rnConDecls@ uses the `global name function' to create a new
315 constructor in which local names have been replaced by their original
316 names, reporting any unknown names.
319 rnConDecls :: TyVarNamesEnv
321 -> RnM_Fixes s [RenamedConDecl]
323 rnConDecls tv_env con_decls
324 = mapRn rn_decl con_decls
326 rn_decl (ConDecl name tys src_loc)
327 = pushSrcLocRn src_loc $
328 lookupConstr name `thenRn` \ new_name ->
329 mapRn rn_bang_ty tys `thenRn` \ new_tys ->
330 returnRn (ConDecl new_name new_tys src_loc)
332 rn_decl (ConOpDecl ty1 op ty2 src_loc)
333 = pushSrcLocRn src_loc $
334 lookupConstr op `thenRn` \ new_op ->
335 rn_bang_ty ty1 `thenRn` \ new_ty1 ->
336 rn_bang_ty ty2 `thenRn` \ new_ty2 ->
337 returnRn (ConOpDecl new_ty1 new_op new_ty2 src_loc)
339 rn_decl (NewConDecl name ty src_loc)
340 = pushSrcLocRn src_loc $
341 lookupConstr name `thenRn` \ new_name ->
342 rn_mono_ty ty `thenRn` \ new_ty ->
343 returnRn (NewConDecl new_name new_ty src_loc)
345 rn_decl (RecConDecl name fields src_loc)
346 = pushSrcLocRn src_loc $
347 lookupConstr name `thenRn` \ new_name ->
348 mapRn rn_field fields `thenRn` \ new_fields ->
349 returnRn (RecConDecl new_name new_fields src_loc)
352 = mapRn lookupField names `thenRn` \ new_names ->
353 rn_bang_ty ty `thenRn` \ new_ty ->
354 returnRn (new_names, new_ty)
356 rn_mono_ty = rnMonoType tv_env
358 rn_bang_ty (Banged ty)
359 = rn_mono_ty ty `thenRn` \ new_ty ->
360 returnRn (Banged new_ty)
361 rn_bang_ty (Unbanged ty)
362 = rn_mono_ty ty `thenRn` \ new_ty ->
363 returnRn (Unbanged new_ty)
366 %*********************************************************
368 \subsection{SPECIALIZE data pragmas}
370 %*********************************************************
373 rnSpecDataSig :: RdrNameSpecDataSig
374 -> RnM_Fixes s RenamedSpecDataSig
376 rnSpecDataSig (SpecDataSig tycon ty src_loc)
377 = pushSrcLocRn src_loc $
379 tyvars = extractMonoTyNames is_tyvar_name ty
381 mkTyVarNamesEnv src_loc tyvars `thenRn` \ (tv_env,_) ->
382 lookupTyCon tycon `thenRn` \ tycon' ->
383 rnMonoType tv_env ty `thenRn` \ ty' ->
384 returnRn (SpecDataSig tycon' ty' src_loc)
386 is_tyvar_name n = isLexVarId (getLocalName n)
389 %*********************************************************
391 \subsection{Class declarations}
393 %*********************************************************
395 @rnClassDecl@ uses the `global name function' to create a new
396 class declaration in which local names have been replaced by their
397 original names, reporting any unknown names.
400 rnClassDecl :: RdrNameClassDecl -> RnM_Fixes s RenamedClassDecl
402 rnClassDecl (ClassDecl context cname tyvar sigs mbinds pragmas src_loc)
403 = pushSrcLocRn src_loc $
404 mkTyVarNamesEnv src_loc [tyvar] `thenRn` \ (tv_env, [tyvar']) ->
405 rnContext tv_env context `thenRn` \ context' ->
406 lookupClass cname `thenRn` \ cname' ->
407 mapRn (rn_op cname' tv_env) sigs `thenRn` \ sigs' ->
408 rnMethodBinds cname' mbinds `thenRn` \ mbinds' ->
409 ASSERT(isNoClassPragmas pragmas)
410 returnRn (ClassDecl context' cname' tyvar' sigs' mbinds' NoClassPragmas src_loc)
412 rn_op clas tv_env (ClassOpSig op ty pragmas locn)
413 = pushSrcLocRn locn $
414 lookupClassOp clas op `thenRn` \ op_name ->
415 rnPolyType tv_env ty `thenRn` \ new_ty ->
418 *** Please check here that tyvar' appears in new_ty ***
419 *** (used to be in tcClassSig, but it's better here)
420 *** not_elem = isn'tIn "tcClassSigs"
421 *** -- Check that the class type variable is mentioned
422 *** checkTc (clas_tyvar `not_elem` extractTyVarTemplatesFromTy local_ty)
423 *** (methodTypeLacksTyVarErr clas_tyvar (_UNPK_ op_name) src_loc) `thenTc_`
426 ASSERT(isNoClassOpPragmas pragmas)
427 returnRn (ClassOpSig op_name new_ty noClassOpPragmas locn)
431 %*********************************************************
433 \subsection{Instance declarations}
435 %*********************************************************
438 @rnInstDecl@ uses the `global name function' to create a new of
439 instance declaration in which local names have been replaced by their
440 original names, reporting any unknown names.
443 rnInstDecl :: RdrNameInstDecl -> RnM_Fixes s RenamedInstDecl
445 rnInstDecl (InstDecl cname ty mbinds from_here modname uprags pragmas src_loc)
446 = pushSrcLocRn src_loc $
447 lookupClass cname `thenRn` \ cname' ->
449 rnPolyType [] ty `thenRn` \ ty' ->
450 -- [] tv_env ensures that tyvars will be foralled
452 rnMethodBinds cname' mbinds `thenRn` \ mbinds' ->
453 mapRn (rn_uprag cname') uprags `thenRn` \ new_uprags ->
455 ASSERT(isNoInstancePragmas pragmas)
456 returnRn (InstDecl cname' ty' mbinds'
457 from_here modname new_uprags noInstancePragmas src_loc)
459 rn_uprag class_name (SpecSig op ty using locn)
460 = pushSrcLocRn src_loc $
461 lookupClassOp class_name op `thenRn` \ op_name ->
462 rnPolyType nullTyVarNamesEnv ty `thenRn` \ new_ty ->
463 rn_using using `thenRn` \ new_using ->
464 returnRn (SpecSig op_name new_ty new_using locn)
466 rn_uprag class_name (InlineSig op locn)
467 = pushSrcLocRn locn $
468 lookupClassOp class_name op `thenRn` \ op_name ->
469 returnRn (InlineSig op_name locn)
471 rn_uprag class_name (DeforestSig op locn)
472 = pushSrcLocRn locn $
473 lookupClassOp class_name op `thenRn` \ op_name ->
474 returnRn (DeforestSig op_name locn)
476 rn_uprag class_name (MagicUnfoldingSig op str locn)
477 = pushSrcLocRn locn $
478 lookupClassOp class_name op `thenRn` \ op_name ->
479 returnRn (MagicUnfoldingSig op_name str locn)
484 = lookupValue v `thenRn` \ new_v ->
485 returnRn (Just new_v)
488 %*********************************************************
490 \subsection{@SPECIALIZE instance@ user-pragmas}
492 %*********************************************************
495 rnSpecInstSig :: RdrNameSpecInstSig
496 -> RnM_Fixes s RenamedSpecInstSig
498 rnSpecInstSig (SpecInstSig clas ty src_loc)
499 = pushSrcLocRn src_loc $
501 tyvars = extractMonoTyNames is_tyvar_name ty
503 mkTyVarNamesEnv src_loc tyvars `thenRn` \ (tv_env,_) ->
504 lookupClass clas `thenRn` \ new_clas ->
505 rnMonoType tv_env ty `thenRn` \ new_ty ->
506 returnRn (SpecInstSig new_clas new_ty src_loc)
509 %*********************************************************
511 \subsection{Default declarations}
513 %*********************************************************
515 @rnDefaultDecl@ uses the `global name function' to create a new set
516 of default declarations in which local names have been replaced by
517 their original names, reporting any unknown names.
520 rnDefaultDecl :: [RdrNameDefaultDecl] -> RnM_Fixes s [RenamedDefaultDecl]
522 rnDefaultDecl [] = returnRn []
523 rnDefaultDecl [DefaultDecl tys src_loc]
524 = pushSrcLocRn src_loc $
525 mapRn (rnMonoType nullTyVarNamesEnv) tys `thenRn` \ tys' ->
526 returnRn [DefaultDecl tys' src_loc]
527 rnDefaultDecl defs@(d:ds)
528 = addErrRn (dupDefaultDeclErr defs) `thenRn_`
532 %*************************************************************************
534 \subsection{Fixity declarations}
536 %*************************************************************************
539 rnFixes :: [RdrNameFixityDecl] -> RnM s [RenamedFixityDecl]
542 = getSrcLocRn `thenRn` \ src_loc ->
544 (_, dup_fixes) = removeDups cmp_fix fixities
545 cmp_fix fix1 fix2 = nameFixDecl fix1 `cmp` nameFixDecl fix2
547 rn_fixity fix@(InfixL name i)
548 = rn_fixity_pieces InfixL name i fix
549 rn_fixity fix@(InfixR name i)
550 = rn_fixity_pieces InfixR name i fix
551 rn_fixity fix@(InfixN name i)
552 = rn_fixity_pieces InfixN name i fix
554 rn_fixity_pieces mk_fixity name i fix
555 = getRnEnv `thenRn` \ env ->
556 case lookupGlobalRnEnv env name of
557 Just res | isLocallyDefined res
558 -> returnRn (Just (mk_fixity res i))
559 _ -> failButContinueRn Nothing (undefinedFixityDeclErr src_loc fix)
561 mapRn (addErrRn . dupFixityDeclErr src_loc) dup_fixes `thenRn_`
562 mapRn rn_fixity fixities `thenRn` \ fixes_maybe ->
563 returnRn (catMaybes fixes_maybe)
565 nameFixDecl (InfixL name i) = name
566 nameFixDecl (InfixR name i) = name
567 nameFixDecl (InfixN name i) = name
570 %*********************************************************
572 \subsection{Support code to rename types}
574 %*********************************************************
577 rnPolyType :: TyVarNamesEnv
579 -> RnM_Fixes s RenamedPolyType
581 rnPolyType tv_env (HsForAllTy tvs ctxt ty)
582 = rn_poly_help tv_env tvs ctxt ty
584 rnPolyType tv_env (HsPreForAllTy ctxt ty)
585 = rn_poly_help tv_env forall_tyvars ctxt ty
587 mentioned_tyvars = extractCtxtTyNames ctxt `unionLists` extractMonoTyNames is_tyvar_name ty
588 forall_tyvars = --pprTrace "mentioned:" (ppCat (map (ppr PprShowAll) mentioned_tyvars)) $
589 --pprTrace "from_ty:" (ppCat (map (ppr PprShowAll) (extractMonoTyNames is_tyvar_name ty))) $
590 mentioned_tyvars `minusList` domTyVarNamesEnv tv_env
593 rn_poly_help :: TyVarNamesEnv
597 -> RnM_Fixes s RenamedPolyType
599 rn_poly_help tv_env tyvars ctxt ty
600 = --pprTrace "rnPolyType:" (ppCat [ppCat (map (ppr PprShowAll . snd) tv_env),
601 -- ppStr ";tvs=", ppCat (map (ppr PprShowAll) tyvars),
602 -- ppStr ";ctxt=", ppCat (map (ppr PprShowAll) ctxt),
603 -- ppStr ";ty=", ppr PprShowAll ty]
605 getSrcLocRn `thenRn` \ src_loc ->
606 mkTyVarNamesEnv src_loc tyvars `thenRn` \ (tv_env1, new_tyvars) ->
608 tv_env2 = catTyVarNamesEnvs tv_env1 tv_env
610 rnContext tv_env2 ctxt `thenRn` \ new_ctxt ->
611 rnMonoType tv_env2 ty `thenRn` \ new_ty ->
612 returnRn (HsForAllTy new_tyvars new_ctxt new_ty)
616 rnMonoType :: TyVarNamesEnv
618 -> RnM_Fixes s RenamedMonoType
620 rnMonoType tv_env (MonoTyVar tyvar)
621 = lookupTyVarName tv_env tyvar `thenRn` \ tyvar' ->
622 returnRn (MonoTyVar tyvar')
624 rnMonoType tv_env (MonoListTy ty)
625 = rnMonoType tv_env ty `thenRn` \ ty' ->
626 returnRn (MonoListTy ty')
628 rnMonoType tv_env (MonoFunTy ty1 ty2)
629 = andRn MonoFunTy (rnMonoType tv_env ty1)
630 (rnMonoType tv_env ty2)
632 rnMonoType tv_env (MonoTupleTy tys)
633 = mapRn (rnMonoType tv_env) tys `thenRn` \ tys' ->
634 returnRn (MonoTupleTy tys')
636 rnMonoType tv_env (MonoTyApp name tys)
638 lookup_fn = if isLexVarId (getLocalName name)
639 then lookupTyVarName tv_env
642 lookup_fn name `thenRn` \ name' ->
643 mapRn (rnMonoType tv_env) tys `thenRn` \ tys' ->
644 returnRn (MonoTyApp name' tys')
648 rnContext :: TyVarNamesEnv -> RdrNameContext -> RnM_Fixes s RenamedContext
650 rnContext tv_env ctxt
653 rn_ctxt (clas, tyvar)
654 = lookupClass clas `thenRn` \ clas_name ->
655 lookupTyVarName tv_env tyvar `thenRn` \ tyvar_name ->
656 returnRn (clas_name, tyvar_name)
661 dupNameExportWarn locn names@((n,_):_)
662 = addShortErrLocLine locn (\ sty ->
663 ppCat [pprNonSym sty n, ppStr "exported", ppInt (length names), ppStr "times"])
665 dupLocalsExportErr locn locals@((str,_):_)
666 = addErrLoc locn "exported names have same local name" (\ sty ->
667 ppInterleave ppSP (map (pprNonSym sty . snd) locals))
669 classOpExportErr op locn
670 = addShortErrLocLine locn (\ sty ->
671 ppBesides [ppStr "class operation `", ppr sty op, ppStr "' can only be exported with class"])
673 synAllExportErr syn locn
674 = addShortErrLocLine locn (\ sty ->
675 ppBesides [ppStr "type synonym `", ppr sty syn, ppStr "' should be exported abstractly"])
677 withExportErr str rn has rns locn
678 = addErrLoc locn "" (\ sty ->
679 ppAboves [ ppBesides [ppStr "inconsistent list of", ppStr str, ppStr "in export list for `", ppr sty rn, ppStr "'"],
680 ppCat [ppStr " expected:", ppInterleave ppComma (map (ppr sty) has)],
681 ppCat [ppStr " found: ", ppInterleave ppComma (map (ppr sty) rns)] ])
684 = addShortErrLocLine locn (\ sty ->
685 ppBesides [ ppStr "`", pprNonSym sty rn, ppStr "' has been exported with (..), but is only imported abstractly"])
687 badModExportErr mod locn
688 = addShortErrLocLine locn (\ sty ->
689 ppCat [ ppStr "unknown module in export list:", ppPStr mod])
691 dupModExportWarn locn mods@(mod:_)
692 = addShortErrLocLine locn (\ sty ->
693 ppCat [ppStr "module", ppPStr mod, ppStr "appears", ppInt (length mods), ppStr "times in export list"])
695 emptyModExportWarn locn mod
696 = addShortErrLocLine locn (\ sty ->
697 ppCat [ppStr "module", ppPStr mod, ppStr "has no unqualified imports to export"])
699 derivingNonStdClassErr clas locn
700 = addShortErrLocLine locn (\ sty ->
701 ppCat [ppStr "non-standard class in deriving:", ppr sty clas])
703 dupDefaultDeclErr (DefaultDecl _ locn1 : dup_things) sty
704 = ppAboves (item1 : map dup_item dup_things)
707 = addShortErrLocLine locn1 (\ sty -> ppStr "multiple default declarations") sty
709 dup_item (DefaultDecl _ locn)
710 = addShortErrLocLine locn (\ sty -> ppStr "here was another default declaration") sty
712 undefinedFixityDeclErr locn decl
713 = addErrLoc locn "fixity declaration for unknown operator" (\ sty ->
716 dupFixityDeclErr locn dups
717 = addErrLoc locn "multiple fixity declarations for same operator" (\ sty ->
718 ppAboves (map (ppr sty) dups))