2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
7 module RnSource ( rnIfaceDecl, rnSourceDecls, rnHsType, rnHsSigType ) where
9 #include "HsVersions.h"
13 import HsDecls ( HsIdInfo(..), HsStrictnessInfo(..) )
15 import HsTypes ( getTyVarName, pprClassAssertion, cmpHsTypes )
16 import RdrName ( RdrName, isRdrDataCon, rdrNameOcc )
17 import RdrHsSyn ( RdrNameContext, RdrNameHsType, RdrNameConDecl,
23 import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs, unknownSigErr )
24 import RnEnv ( bindTyVarsRn, lookupBndrRn, lookupOccRn,
25 lookupImplicitOccRn, addImplicitOccRn,
27 bindTyVarsFVRn, bindTyVarsFV2Rn, extendTyVarEnvFVRn,
28 checkDupOrQualNames, checkDupNames,
29 newLocallyDefinedGlobalName, newImportedGlobalName,
30 newImportedGlobalFromRdrName,
32 FreeVars, emptyFVs, plusFV, plusFVs, unitFV, addOneFV
36 import Name ( Name, OccName,
37 ExportFlag(..), Provenance(..),
38 nameOccName, NamedThing(..),
39 mkDefaultMethodOcc, mkDFunOcc
42 import BasicTypes ( TopLevelFlag(..) )
43 import TysWiredIn ( tupleTyCon, unboxedTupleTyCon, listTyCon )
44 import Type ( funTyCon )
45 import FiniteMap ( elemFM )
46 import PrelInfo ( derivingOccurrences, numClass_RDR,
47 deRefStablePtr_NAME, makeStablePtr_NAME,
50 import Bag ( bagToList )
51 import List ( partition )
53 import SrcLoc ( SrcLoc )
54 import CmdLineOpts ( opt_WarnUnusedMatches ) -- Warn of unused for-all'd tyvars
55 import UniqFM ( lookupUFM )
56 import Maybes ( maybeToBool, catMaybes )
60 rnDecl `renames' declarations.
61 It simultaneously performs dependency analysis and precedence parsing.
62 It also does the following error checks:
65 Checks that tyvars are used properly. This includes checking
66 for undefined tyvars, and tyvars in contexts that are ambiguous.
68 Checks that all variable occurences are defined.
70 Checks the (..) etc constraints in the export list.
74 %*********************************************************
76 \subsection{Value declarations}
78 %*********************************************************
81 rnSourceDecls :: [RdrNameHsDecl] -> RnMS s ([RenamedHsDecl], FreeVars)
82 -- The decls get reversed, but that's ok
85 = go emptyFVs [] decls
87 -- Fixity decls have been dealt with already; ignore them
88 go fvs ds' [] = returnRn (ds', fvs)
89 go fvs ds' (FixD _:ds) = go fvs ds' ds
90 go fvs ds' (d:ds) = rnDecl d `thenRn` \(d', fvs') ->
91 go (fvs `plusFV` fvs') (d':ds') ds
93 rnIfaceDecl :: RdrNameHsDecl -> RnMS s RenamedHsDecl
95 = rnDecl d `thenRn` \ (d', fvs) ->
100 %*********************************************************
102 \subsection{Value declarations}
104 %*********************************************************
107 -- rnDecl does all the work
108 rnDecl :: RdrNameHsDecl -> RnMS s (RenamedHsDecl, FreeVars)
110 rnDecl (ValD binds) = rnTopBinds binds `thenRn` \ (new_binds, fvs) ->
111 returnRn (ValD new_binds, fvs)
114 rnDecl (SigD (IfaceSig name ty id_infos loc))
116 lookupBndrRn name `thenRn` \ name' ->
117 rnIfaceType doc_str ty `thenRn` \ ty' ->
119 -- Get the pragma info (if any).
120 setModeRn (InterfaceMode Optional) $
121 -- In all the rest of the signature we read in optional mode,
122 -- so that (a) we don't die
123 mapRn rnIdInfo id_infos `thenRn` \ id_infos' ->
124 returnRn (SigD (IfaceSig name' ty' id_infos' loc), emptyFVs)
125 -- Don't need free-var info for iface binds
127 doc_str = text "the interface signature for" <+> quotes (ppr name)
130 %*********************************************************
132 \subsection{Type declarations}
134 %*********************************************************
136 @rnTyDecl@ uses the `global name function' to create a new type
137 declaration in which local names have been replaced by their original
138 names, reporting any unknown names.
140 Renaming type variables is a pain. Because they now contain uniques,
141 it is necessary to pass in an association list which maps a parsed
142 tyvar to its Name representation. In some cases (type signatures of
143 values), it is even necessary to go over the type first in order to
144 get the set of tyvars used by it, make an assoc list, and then go over
145 it again to rename the tyvars! However, we can also do some scoping
146 checks at the same time.
149 rnDecl (TyClD (TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc))
150 = pushSrcLocRn src_loc $
151 lookupBndrRn tycon `thenRn` \ tycon' ->
152 bindTyVarsFVRn data_doc tyvars $ \ tyvars' ->
153 rnContext data_doc context `thenRn` \ (context', cxt_fvs) ->
154 checkDupOrQualNames data_doc con_names `thenRn_`
155 mapAndUnzipRn rnConDecl condecls `thenRn` \ (condecls', con_fvs_s) ->
156 rnDerivs derivings `thenRn` \ (derivings', deriv_fvs) ->
157 ASSERT(isNoDataPragmas pragmas)
158 returnRn (TyClD (TyData new_or_data context' tycon' tyvars' condecls' derivings' noDataPragmas src_loc),
159 cxt_fvs `plusFV` plusFVs con_fvs_s `plusFV` deriv_fvs)
161 data_doc = text "the data type declaration for" <+> quotes (ppr tycon)
162 con_names = map conDeclName condecls
164 rnDecl (TyClD (TySynonym name tyvars ty src_loc))
165 = pushSrcLocRn src_loc $
166 lookupBndrRn name `thenRn` \ name' ->
167 bindTyVarsFVRn syn_doc tyvars $ \ tyvars' ->
168 rnHsType syn_doc ty `thenRn` \ (ty', ty_fvs) ->
169 returnRn (TyClD (TySynonym name' tyvars' ty' src_loc), ty_fvs)
171 syn_doc = text "the declaration for type synonym" <+> quotes (ppr name)
173 rnDecl (TyClD (ClassDecl context cname tyvars sigs mbinds pragmas tname dname src_loc))
174 = pushSrcLocRn src_loc $
176 lookupBndrRn cname `thenRn` \ cname' ->
178 -- Deal with the implicit tycon and datacon name
179 -- They aren't in scope (because they aren't visible to the user)
180 -- and what we want to do is simply look them up in the cache;
181 -- we jolly well ought to get a 'hit' there!
182 -- So the 'Imported' part of this call is not relevant.
183 -- Unclean; but since these two are the only place this happens
184 -- I can't work up the energy to do it more beautifully
185 newImportedGlobalFromRdrName tname `thenRn` \ tname' ->
186 newImportedGlobalFromRdrName dname `thenRn` \ dname' ->
188 -- Tyvars scope over bindings and context
189 bindTyVarsFV2Rn cls_doc tyvars ( \ clas_tyvar_names tyvars' ->
191 -- Check the superclasses
192 rnContext cls_doc context `thenRn` \ (context', cxt_fvs) ->
194 -- Check the signatures
196 -- First process the class op sigs, then the fixity sigs.
197 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
198 (fix_sigs, non_sigs) = partition isFixitySig non_op_sigs
200 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
201 mapAndUnzipRn (rn_op cname' clas_tyvar_names) op_sigs `thenRn` \ (sigs', sig_fvs_s) ->
202 mapRn_ (unknownSigErr) non_sigs `thenRn_`
204 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
206 renameSigs False binders lookupOccRn fix_sigs `thenRn` \ (fixs', fix_fvs) ->
209 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
210 rnMethodBinds mbinds `thenRn` \ (mbinds', meth_fvs) ->
212 -- Typechecker is responsible for checking that we only
213 -- give default-method bindings for things in this class.
214 -- The renamer *could* check this for class decls, but can't
215 -- for instance decls.
217 ASSERT(isNoClassPragmas pragmas)
218 returnRn (TyClD (ClassDecl context' cname' tyvars' (fixs' ++ sigs') mbinds' NoClassPragmas tname' dname' src_loc),
219 plusFVs sig_fvs_s `plusFV`
226 cls_doc = text "the declaration for class" <+> ppr cname
227 sig_doc = text "the signatures for class" <+> ppr cname
228 meth_doc = text "the default-methods for class" <+> ppr cname
230 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
231 meth_rdr_names_w_locs = bagToList (collectMonoBinders mbinds)
232 meth_rdr_names = map fst meth_rdr_names_w_locs
234 rn_op clas clas_tyvars sig@(ClassOpSig op maybe_dm ty locn)
235 = pushSrcLocRn locn $
236 lookupBndrRn op `thenRn` \ op_name ->
238 -- Check the signature
239 rnHsSigType (quotes (ppr op)) ty `thenRn` \ (new_ty, op_ty_fvs) ->
241 check_in_op_ty clas_tyvar = checkRn (clas_tyvar `elemNameSet` op_ty_fvs)
242 (classTyVarNotInOpTyErr clas_tyvar sig)
244 mapRn_ check_in_op_ty clas_tyvars `thenRn_`
246 -- Make the default-method name
248 dm_occ = mkDefaultMethodOcc (rdrNameOcc op)
250 getModuleRn `thenRn` \ mod_name ->
251 getModeRn `thenRn` \ mode ->
252 (case (mode, maybe_dm) of
253 (SourceMode, _) | op `elem` meth_rdr_names
254 -> -- There's an explicit method decl
255 newLocallyDefinedGlobalName mod_name dm_occ
256 (\_ -> Exported) locn `thenRn` \ dm_name ->
257 returnRn (Just dm_name)
259 (InterfaceMode _, Just _)
260 -> -- Imported class that has a default method decl
261 newImportedGlobalName mod_name dm_occ `thenRn` \ dm_name ->
262 addOccurrenceName dm_name `thenRn_`
263 returnRn (Just dm_name)
265 other -> returnRn Nothing
266 ) `thenRn` \ maybe_dm_name ->
269 returnRn (ClassOpSig op_name maybe_dm_name new_ty locn, op_ty_fvs)
273 %*********************************************************
275 \subsection{Instance declarations}
277 %*********************************************************
280 rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun src_loc))
281 = pushSrcLocRn src_loc $
282 rnHsSigType (text "an instance decl") inst_ty `thenRn` \ (inst_ty', inst_fvs) ->
284 inst_tyvars = case inst_ty' of
285 HsForAllTy (Just inst_tyvars) _ _ -> inst_tyvars
287 -- (Slightly strangely) the forall-d tyvars scope over
288 -- the method bindings too
290 extendTyVarEnvFVRn inst_tyvars $
292 -- Rename the bindings
293 -- NB meth_names can be qualified!
294 checkDupNames meth_doc meth_names `thenRn_`
295 rnMethodBinds mbinds `thenRn` \ (mbinds', meth_fvs) ->
297 binders = mkNameSet (map fst (bagToList (collectMonoBinders mbinds')))
299 -- Delete sigs (&report) sigs that aren't allowed inside an
305 (ok_sigs, not_ok_idecl_sigs) = partition okInInstDecl uprags
307 okInInstDecl (FixSig _) = False
308 okInInstDecl (Sig _ _ _) = False
309 okInInstDecl _ = True
312 -- You can't have fixity decls & type signatures
313 -- within an instance declaration.
314 mapRn_ unknownSigErr not_ok_idecl_sigs `thenRn_`
315 renameSigs False binders lookupOccRn ok_sigs `thenRn` \ (new_uprags, prag_fvs) ->
316 mkDFunName inst_ty' maybe_dfun src_loc `thenRn` \ dfun_name ->
317 addOccurrenceName dfun_name `thenRn_`
318 -- The dfun is not optional, because we use its version number
319 -- to identify the version of the instance declaration
321 -- The typechecker checks that all the bindings are for the right class.
322 returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags (Just dfun_name) src_loc),
323 inst_fvs `plusFV` meth_fvs `plusFV` prag_fvs)
325 meth_doc = text "the bindings in an instance declaration"
326 meth_names = bagToList (collectMonoBinders mbinds)
329 %*********************************************************
331 \subsection{Default declarations}
333 %*********************************************************
336 rnDecl (DefD (DefaultDecl tys src_loc))
337 = pushSrcLocRn src_loc $
338 rnHsTypes doc_str tys `thenRn` \ (tys', fvs) ->
339 lookupImplicitOccRn numClass_RDR `thenRn_`
340 returnRn (DefD (DefaultDecl tys' src_loc), fvs)
342 doc_str = text "a `default' declaration"
345 %*********************************************************
347 \subsection{Foreign declarations}
349 %*********************************************************
352 rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
353 = pushSrcLocRn src_loc $
354 lookupBndrRn name `thenRn` \ name' ->
356 FoImport _ | not isDyn -> addImplicitOccRn name'
357 FoLabel -> addImplicitOccRn name'
359 addImplicitOccRn makeStablePtr_NAME `thenRn_`
360 addImplicitOccRn deRefStablePtr_NAME `thenRn_`
361 addImplicitOccRn bindIO_NAME `thenRn_`
363 _ -> returnRn name') `thenRn_`
364 rnHsSigType fo_decl_msg ty `thenRn` \ (ty', fvs) ->
365 returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc), fvs)
367 fo_decl_msg = ptext SLIT("a foreign declaration")
368 isDyn = isDynamic ext_nm
372 %*********************************************************
374 \subsection{Support code for type/data declarations}
376 %*********************************************************
379 rnDerivs :: Maybe [RdrName] -> RnMS s (Maybe [Name], FreeVars)
381 rnDerivs Nothing -- derivs not specified
382 = returnRn (Nothing, emptyFVs)
385 = mapRn rn_deriv ds `thenRn` \ derivs ->
386 returnRn (Just derivs, foldl addOneFV emptyFVs derivs)
389 = lookupOccRn clas `thenRn` \ clas_name ->
391 -- Now add extra "occurrences" for things that
392 -- the deriving mechanism will later need in order to
393 -- generate code for this class.
394 case lookupUFM derivingOccurrences clas_name of
395 Nothing -> addErrRn (derivingNonStdClassErr clas_name) `thenRn_`
398 Just occs -> mapRn_ lookupImplicitOccRn occs `thenRn_`
404 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
405 conDeclName (ConDecl n _ _ _ l) = (n,l)
407 rnConDecl :: RdrNameConDecl -> RnMS s (RenamedConDecl, FreeVars)
408 rnConDecl (ConDecl name tvs cxt details locn)
409 = pushSrcLocRn locn $
410 checkConName name `thenRn_`
411 lookupBndrRn name `thenRn` \ new_name ->
412 bindTyVarsFVRn doc tvs $ \ new_tyvars ->
413 rnContext doc cxt `thenRn` \ (new_context, cxt_fvs) ->
414 rnConDetails doc locn details `thenRn` \ (new_details, det_fvs) ->
415 returnRn (ConDecl new_name new_tyvars new_context new_details locn,
416 cxt_fvs `plusFV` det_fvs)
418 doc = text "the definition of data constructor" <+> quotes (ppr name)
420 rnConDetails doc locn (VanillaCon tys)
421 = mapAndUnzipRn (rnBangTy doc) tys `thenRn` \ (new_tys, fvs_s) ->
422 returnRn (VanillaCon new_tys, plusFVs fvs_s)
424 rnConDetails doc locn (InfixCon ty1 ty2)
425 = rnBangTy doc ty1 `thenRn` \ (new_ty1, fvs1) ->
426 rnBangTy doc ty2 `thenRn` \ (new_ty2, fvs2) ->
427 returnRn (InfixCon new_ty1 new_ty2, fvs1 `plusFV` fvs2)
429 rnConDetails doc locn (NewCon ty mb_field)
430 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
431 rn_field mb_field `thenRn` \ new_mb_field ->
432 returnRn (NewCon new_ty new_mb_field, fvs)
434 rn_field Nothing = returnRn Nothing
436 lookupBndrRn f `thenRn` \ new_f ->
437 returnRn (Just new_f)
439 rnConDetails doc locn (RecCon fields)
440 = checkDupOrQualNames doc field_names `thenRn_`
441 mapAndUnzipRn (rnField doc) fields `thenRn` \ (new_fields, fvs_s) ->
442 returnRn (RecCon new_fields, plusFVs fvs_s)
444 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
446 rnField doc (names, ty)
447 = mapRn lookupBndrRn names `thenRn` \ new_names ->
448 rnBangTy doc ty `thenRn` \ (new_ty, fvs) ->
449 returnRn ((new_names, new_ty), fvs)
451 rnBangTy doc (Banged ty)
452 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
453 returnRn (Banged new_ty, fvs)
455 rnBangTy doc (Unbanged ty)
456 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
457 returnRn (Unbanged new_ty, fvs)
459 rnBangTy doc (Unpacked ty)
460 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
461 returnRn (Unpacked new_ty, fvs)
463 -- This data decl will parse OK
465 -- treating "a" as the constructor.
466 -- It is really hard to make the parser spot this malformation.
467 -- So the renamer has to check that the constructor is legal
469 -- We can get an operator as the constructor, even in the prefix form:
470 -- data T = :% Int Int
471 -- from interface files, which always print in prefix form
474 = checkRn (isRdrDataCon name)
479 %*********************************************************
481 \subsection{Naming a dfun}
483 %*********************************************************
485 Make a name for the dict fun for an instance decl
488 mkDFunName :: RenamedHsType -- Instance type
489 -> Maybe RdrName -- Dfun thing from decl; Nothing <=> source
493 mkDFunName inst_ty maybe_df src_loc
494 = newDFunName cl_occ tycon_occ maybe_df src_loc
496 (cl_occ, tycon_occ) = get_key inst_ty
498 get_key (HsForAllTy _ _ ty) = get_key ty
499 get_key (MonoFunTy _ ty) = get_key ty
500 get_key (MonoDictTy cls (ty:_)) = (nameOccName cls, get_tycon_key ty)
502 get_tycon_key (MonoTyVar tv) = nameOccName (getName tv)
503 get_tycon_key (MonoTyApp ty _) = get_tycon_key ty
504 get_tycon_key (MonoTupleTy tys True) = getOccName (tupleTyCon (length tys))
505 get_tycon_key (MonoTupleTy tys False) = getOccName (unboxedTupleTyCon (length tys))
506 get_tycon_key (MonoListTy _) = getOccName listTyCon
507 get_tycon_key (MonoFunTy _ _) = getOccName funTyCon
511 %*********************************************************
513 \subsection{Support code to rename types}
515 %*********************************************************
518 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS s (RenamedHsType, FreeVars)
519 -- rnHsSigType is used for source-language type signatures,
520 -- which use *implicit* universal quantification.
521 rnHsSigType doc_str ty
522 = rnHsType (text "the type signature for" <+> doc_str) ty
524 rnIfaceType :: SDoc -> RdrNameHsType -> RnMS s RenamedHsType
526 = rnHsType doc ty `thenRn` \ (ty,_) ->
530 rnForAll doc forall_tyvars ctxt ty
531 = bindTyVarsFVRn doc forall_tyvars $ \ new_tyvars ->
532 rnContext doc ctxt `thenRn` \ (new_ctxt, cxt_fvs) ->
533 rnHsType doc ty `thenRn` \ (new_ty, ty_fvs) ->
534 returnRn (mkHsForAllTy new_tyvars new_ctxt new_ty,
535 cxt_fvs `plusFV` ty_fvs)
537 -- Check that each constraint mentions at least one of the forall'd type variables
538 -- Since the forall'd type variables are a subset of the free tyvars
539 -- of the tau-type part, this guarantees that every constraint mentions
540 -- at least one of the free tyvars in ty
541 checkConstraints explicit_forall doc forall_tyvars ctxt ty
542 = mapRn check ctxt `thenRn` \ maybe_ctxt' ->
543 returnRn (catMaybes maybe_ctxt')
544 -- Remove problem ones, to avoid duplicate error message.
547 | forall_mentioned = returnRn (Just ct)
548 | otherwise = addErrRn (ctxtErr explicit_forall doc forall_tyvars ct ty) `thenRn_`
551 forall_mentioned = foldr ((||) . any (`elem` forall_tyvars) . extractHsTyVars)
556 rnHsType :: SDoc -> RdrNameHsType -> RnMS s (RenamedHsType, FreeVars)
558 rnHsType doc (HsForAllTy Nothing ctxt ty)
559 -- From source code (no kinds on tyvars)
560 -- Given the signature C => T we universally quantify
561 -- over FV(T) \ {in-scope-tyvars}
562 = getLocalNameEnv `thenRn` \ name_env ->
564 mentioned_tyvars = extractHsTyVars ty
565 forall_tyvars = filter (not . (`elemFM` name_env)) mentioned_tyvars
567 checkConstraints False doc forall_tyvars ctxt ty `thenRn` \ ctxt' ->
568 rnForAll doc (map UserTyVar forall_tyvars) ctxt' ty
570 rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt ty)
571 -- Explicit quantification.
572 -- Check that the forall'd tyvars are a subset of the
573 -- free tyvars in the tau-type part
574 -- That's only a warning... unless the tyvar is constrained by a
575 -- context in which case it's an error
577 mentioned_tyvars = extractHsTyVars ty
578 constrained_tyvars = [tv | (_,tys) <- ctxt,
580 tv <- extractHsTyVars ty]
581 dubious_guys = filter (`notElem` mentioned_tyvars) forall_tyvar_names
582 (bad_guys, warn_guys) = partition (`elem` constrained_tyvars) dubious_guys
583 forall_tyvar_names = map getTyVarName forall_tyvars
585 mapRn_ (forAllErr doc ty) bad_guys `thenRn_`
586 mapRn_ (forAllWarn doc ty) warn_guys `thenRn_`
587 checkConstraints True doc forall_tyvar_names ctxt ty `thenRn` \ ctxt' ->
588 rnForAll doc forall_tyvars ctxt' ty
590 rnHsType doc (MonoTyVar tyvar)
591 = lookupOccRn tyvar `thenRn` \ tyvar' ->
592 returnRn (MonoTyVar tyvar', unitFV tyvar')
594 rnHsType doc (MonoFunTy ty1 ty2)
595 = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
596 rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
597 returnRn (MonoFunTy ty1' ty2', fvs1 `plusFV` fvs2)
599 rnHsType doc (MonoListTy ty)
600 = addImplicitOccRn listTyCon_name `thenRn_`
601 rnHsType doc ty `thenRn` \ (ty', fvs) ->
602 returnRn (MonoListTy ty', fvs `addOneFV` listTyCon_name)
604 rnHsType doc (MonoTupleTy tys boxed)
605 = addImplicitOccRn tup_con_name `thenRn_`
606 rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
607 returnRn (MonoTupleTy tys' boxed, fvs `addOneFV` tup_con_name)
609 tup_con_name = tupleTyCon_name boxed (length tys)
611 rnHsType doc (MonoTyApp ty1 ty2)
612 = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
613 rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
614 returnRn (MonoTyApp ty1' ty2', fvs1 `plusFV` fvs2)
616 rnHsType doc (MonoDictTy clas tys)
617 = lookupOccRn clas `thenRn` \ clas' ->
618 rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
619 returnRn (MonoDictTy clas' tys', fvs `addOneFV` clas')
621 rnHsType doc (MonoUsgTy usg ty)
622 = rnHsType doc ty `thenRn` \ (ty', fvs) ->
623 returnRn (MonoUsgTy usg ty', fvs)
626 = mapAndUnzipRn (rnHsType doc) tys `thenRn` \ (tys, fvs_s) ->
627 returnRn (tys, plusFVs fvs_s)
632 rnContext :: SDoc -> RdrNameContext -> RnMS s (RenamedContext, FreeVars)
635 = mapAndUnzipRn rn_ctxt ctxt `thenRn` \ (theta, fvs_s) ->
637 (_, dup_asserts) = removeDups cmp_assert theta
639 -- Check for duplicate assertions
640 -- If this isn't an error, then it ought to be:
641 mapRn_ (addWarnRn . dupClassAssertWarn theta) dup_asserts `thenRn_`
643 returnRn (theta, plusFVs fvs_s)
646 = lookupOccRn clas `thenRn` \ clas_name ->
647 rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
648 returnRn ((clas_name, tys'), fvs `addOneFV` clas_name)
650 cmp_assert (c1,tys1) (c2,tys2)
651 = (c1 `compare` c2) `thenCmp` (cmpHsTypes compare tys1 tys2)
655 %*********************************************************
659 %*********************************************************
662 rnIdInfo (HsStrictness str) = returnRn (HsStrictness str)
664 rnIdInfo (HsWorker worker cons)
665 -- The sole purpose of the "cons" field is so that we can mark the
666 -- constructors needed to build the wrapper as "needed", so that their
667 -- data type decl will be slurped in. After that their usefulness is
668 -- o'er, so we just put in the empty list.
669 = lookupOccRn worker `thenRn` \ worker' ->
670 mapRn lookupOccRn cons `thenRn_`
671 returnRn (HsWorker worker' [])
673 rnIdInfo (HsUnfold inline (Just expr)) = rnCoreExpr expr `thenRn` \ expr' ->
674 returnRn (HsUnfold inline (Just expr'))
675 rnIdInfo (HsUnfold inline Nothing) = returnRn (HsUnfold inline Nothing)
676 rnIdInfo (HsArity arity) = returnRn (HsArity arity)
677 rnIdInfo (HsUpdate update) = returnRn (HsUpdate update)
678 rnIdInfo (HsNoCafRefs) = returnRn (HsNoCafRefs)
679 rnIdInfo (HsCprInfo cpr_info) = returnRn (HsCprInfo cpr_info)
680 rnIdInfo (HsSpecialise tyvars tys expr)
681 = bindTyVarsRn doc tyvars $ \ tyvars' ->
682 rnCoreExpr expr `thenRn` \ expr' ->
683 mapRn (rnIfaceType doc) tys `thenRn` \ tys' ->
684 returnRn (HsSpecialise tyvars' tys' expr')
686 doc = text "Specialise in interface pragma"
692 rnCoreExpr (UfType ty)
693 = rnIfaceType (text "unfolding type") ty `thenRn` \ ty' ->
694 returnRn (UfType ty')
697 = lookupOccRn v `thenRn` \ v' ->
700 rnCoreExpr (UfCon con args)
701 = rnUfCon con `thenRn` \ con' ->
702 mapRn rnCoreExpr args `thenRn` \ args' ->
703 returnRn (UfCon con' args')
705 rnCoreExpr (UfTuple con args)
706 = lookupOccRn con `thenRn` \ con' ->
707 mapRn rnCoreExpr args `thenRn` \ args' ->
708 returnRn (UfTuple con' args')
710 rnCoreExpr (UfApp fun arg)
711 = rnCoreExpr fun `thenRn` \ fun' ->
712 rnCoreExpr arg `thenRn` \ arg' ->
713 returnRn (UfApp fun' arg')
715 rnCoreExpr (UfCase scrut bndr alts)
716 = rnCoreExpr scrut `thenRn` \ scrut' ->
717 bindLocalsRn "a UfCase" [bndr] $ \ [bndr'] ->
718 mapRn rnCoreAlt alts `thenRn` \ alts' ->
719 returnRn (UfCase scrut' bndr' alts')
721 rnCoreExpr (UfNote note expr)
722 = rnNote note `thenRn` \ note' ->
723 rnCoreExpr expr `thenRn` \ expr' ->
724 returnRn (UfNote note' expr')
726 rnCoreExpr (UfLam bndr body)
727 = rnCoreBndr bndr $ \ bndr' ->
728 rnCoreExpr body `thenRn` \ body' ->
729 returnRn (UfLam bndr' body')
731 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
732 = rnCoreExpr rhs `thenRn` \ rhs' ->
733 rnCoreBndr bndr $ \ bndr' ->
734 rnCoreExpr body `thenRn` \ body' ->
735 returnRn (UfLet (UfNonRec bndr' rhs') body')
737 rnCoreExpr (UfLet (UfRec pairs) body)
738 = rnCoreBndrs bndrs $ \ bndrs' ->
739 mapRn rnCoreExpr rhss `thenRn` \ rhss' ->
740 rnCoreExpr body `thenRn` \ body' ->
741 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
743 (bndrs, rhss) = unzip pairs
747 rnCoreBndr (UfValBinder name ty) thing_inside
748 = rnIfaceType (text str) ty `thenRn` \ ty' ->
749 bindLocalsRn str [name] $ \ [name'] ->
750 thing_inside (UfValBinder name' ty')
754 rnCoreBndr (UfTyBinder name kind) thing_inside
755 = bindLocalsRn "an unfolding tyvar" [name] $ \ [name'] ->
756 thing_inside (UfTyBinder name' kind)
758 rnCoreBndrs bndrs thing_inside -- Expect them all to be ValBinders
759 = mapRn (rnIfaceType (text str)) tys `thenRn` \ tys' ->
760 bindLocalsRn str names $ \ names' ->
761 thing_inside (zipWith UfValBinder names' tys')
764 names = map (\ (UfValBinder name _ ) -> name) bndrs
765 tys = map (\ (UfValBinder _ ty) -> ty) bndrs
769 rnCoreAlt (con, bndrs, rhs)
770 = rnUfCon con `thenRn` \ con' ->
771 bindLocalsRn "an unfolding alt" bndrs $ \ bndrs' ->
772 rnCoreExpr rhs `thenRn` \ rhs' ->
773 returnRn (con', bndrs', rhs')
777 = rnIfaceType (text "unfolding coerce") ty `thenRn` \ ty' ->
778 returnRn (UfCoerce ty')
780 rnNote (UfSCC cc) = returnRn (UfSCC cc)
781 rnNote UfInlineCall = returnRn UfInlineCall
787 rnUfCon (UfDataCon con)
788 = lookupOccRn con `thenRn` \ con' ->
789 returnRn (UfDataCon con')
791 rnUfCon (UfLitCon lit)
792 = returnRn (UfLitCon lit)
794 rnUfCon (UfLitLitCon lit ty)
795 = rnIfaceType (text "litlit") ty `thenRn` \ ty' ->
796 returnRn (UfLitLitCon lit ty')
798 rnUfCon (UfPrimOp op)
799 = lookupOccRn op `thenRn` \ op' ->
800 returnRn (UfPrimOp op')
802 rnUfCon (UfCCallOp str is_dyn casm gc)
803 = returnRn (UfCCallOp str is_dyn casm gc)
806 %*********************************************************
810 %*********************************************************
813 derivingNonStdClassErr clas
814 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
816 classTyVarNotInOpTyErr clas_tyvar sig
817 = hang (hsep [ptext SLIT("Class type variable"),
818 quotes (ppr clas_tyvar),
819 ptext SLIT("does not appear in method signature")])
822 dupClassAssertWarn ctxt (assertion : dups)
823 = sep [hsep [ptext SLIT("Duplicate class assertion"),
824 quotes (pprClassAssertion assertion),
825 ptext SLIT("in the context:")],
826 nest 4 (pprContext ctxt <+> ptext SLIT("..."))]
829 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
831 forAllWarn doc ty tyvar
832 | not opt_WarnUnusedMatches = returnRn ()
835 sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
836 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
838 (ptext SLIT("In") <+> doc))
840 forAllErr doc ty tyvar
842 sep [ptext SLIT("The constrained type variable") <+> quotes (ppr tyvar),
843 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
845 (ptext SLIT("In") <+> doc))
847 ctxtErr explicit_forall doc tyvars constraint ty
848 = sep [ptext SLIT("The constraint") <+> quotes (pprClassAssertion constraint) <+>
849 ptext SLIT("does not mention any of"),
850 if explicit_forall then
851 nest 4 (ptext SLIT("the universally quantified type variables") <+> braces (interpp'SP tyvars))
853 nest 4 (ptext SLIT("the type variables in the type") <+> quotes (ppr ty))
856 (ptext SLIT("In") <+> doc)