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 )
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 -- Filter out fixity signatures;
197 -- they are done at top level
198 nofix_sigs = nonFixitySigs sigs
200 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
201 mapAndUnzipRn (rn_op cname' clas_tyvar_names) nofix_sigs `thenRn` \ (sigs', sig_fvs_s) ->
204 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
205 rnMethodBinds mbinds `thenRn` \ (mbinds', meth_fvs) ->
207 -- Typechecker is responsible for checking that we only
208 -- give default-method bindings for things in this class.
209 -- The renamer *could* check this for class decls, but can't
210 -- for instance decls.
212 ASSERT(isNoClassPragmas pragmas)
213 returnRn (TyClD (ClassDecl context' cname' tyvars' sigs' mbinds' NoClassPragmas tname' dname' src_loc),
214 plusFVs sig_fvs_s `plusFV` cxt_fvs `plusFV` meth_fvs)
217 cls_doc = text "the declaration for class" <+> ppr cname
218 sig_doc = text "the signatures for class" <+> ppr cname
219 meth_doc = text "the default-methods for class" <+> ppr cname
221 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
222 meth_rdr_names_w_locs = bagToList (collectMonoBinders mbinds)
223 meth_rdr_names = map fst meth_rdr_names_w_locs
225 rn_op clas clas_tyvars sig@(ClassOpSig op maybe_dm ty locn)
226 = pushSrcLocRn locn $
227 lookupBndrRn op `thenRn` \ op_name ->
229 -- Check the signature
230 rnHsSigType (quotes (ppr op)) ty `thenRn` \ (new_ty, op_ty_fvs) ->
232 check_in_op_ty clas_tyvar = checkRn (clas_tyvar `elemNameSet` op_ty_fvs)
233 (classTyVarNotInOpTyErr clas_tyvar sig)
235 mapRn check_in_op_ty clas_tyvars `thenRn_`
237 -- Make the default-method name
239 dm_occ = mkDefaultMethodOcc (rdrNameOcc op)
241 getModuleRn `thenRn` \ mod_name ->
242 getModeRn `thenRn` \ mode ->
243 (case (mode, maybe_dm) of
244 (SourceMode, _) | op `elem` meth_rdr_names
245 -> -- There's an explicit method decl
246 newLocallyDefinedGlobalName mod_name dm_occ
247 (\_ -> Exported) locn `thenRn` \ dm_name ->
248 returnRn (Just dm_name)
250 (InterfaceMode _, Just _)
251 -> -- Imported class that has a default method decl
252 newImportedGlobalName mod_name dm_occ `thenRn` \ dm_name ->
253 addOccurrenceName dm_name `thenRn_`
254 returnRn (Just dm_name)
256 other -> returnRn Nothing
257 ) `thenRn` \ maybe_dm_name ->
260 returnRn (ClassOpSig op_name maybe_dm_name new_ty locn, op_ty_fvs)
264 %*********************************************************
266 \subsection{Instance declarations}
268 %*********************************************************
271 rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun src_loc))
272 = pushSrcLocRn src_loc $
273 rnHsSigType (text "an instance decl") inst_ty `thenRn` \ (inst_ty', inst_fvs) ->
275 inst_tyvars = case inst_ty' of
276 HsForAllTy (Just inst_tyvars) _ _ -> inst_tyvars
278 -- (Slightly strangely) the forall-d tyvars scope over
279 -- the method bindings too
281 extendTyVarEnvFVRn inst_tyvars $
283 -- Rename the bindings
284 -- NB meth_names can be qualified!
285 checkDupNames meth_doc meth_names `thenRn_`
286 rnMethodBinds mbinds `thenRn` \ (mbinds', meth_fvs) ->
288 binders = mkNameSet (map fst (bagToList (collectMonoBinders mbinds')))
290 renameSigs NotTopLevel True binders uprags `thenRn` \ (new_uprags, prag_fvs) ->
291 mkDFunName inst_ty' maybe_dfun src_loc `thenRn` \ dfun_name ->
292 addOccurrenceName dfun_name `thenRn_`
293 -- The dfun is not optional, because we use its version number
294 -- to identify the version of the instance declaration
296 -- The typechecker checks that all the bindings are for the right class.
297 returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags (Just dfun_name) src_loc),
298 inst_fvs `plusFV` meth_fvs `plusFV` prag_fvs)
300 meth_doc = text "the bindings in an instance declaration"
301 meth_names = bagToList (collectMonoBinders mbinds)
304 %*********************************************************
306 \subsection{Default declarations}
308 %*********************************************************
311 rnDecl (DefD (DefaultDecl tys src_loc))
312 = pushSrcLocRn src_loc $
313 rnHsTypes doc_str tys `thenRn` \ (tys', fvs) ->
314 lookupImplicitOccRn numClass_RDR `thenRn_`
315 returnRn (DefD (DefaultDecl tys' src_loc), fvs)
317 doc_str = text "a `default' declaration"
320 %*********************************************************
322 \subsection{Foreign declarations}
324 %*********************************************************
327 rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
328 = pushSrcLocRn src_loc $
329 lookupBndrRn name `thenRn` \ name' ->
331 FoImport _ | not isDyn -> addImplicitOccRn name'
332 FoLabel -> addImplicitOccRn name'
334 addImplicitOccRn makeStablePtr_NAME `thenRn_`
335 addImplicitOccRn deRefStablePtr_NAME `thenRn_`
336 addImplicitOccRn bindIO_NAME `thenRn_`
338 _ -> returnRn name') `thenRn_`
339 rnHsSigType fo_decl_msg ty `thenRn` \ (ty', fvs) ->
340 returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc), fvs)
342 fo_decl_msg = ptext SLIT("a foreign declaration")
343 isDyn = isDynamic ext_nm
347 %*********************************************************
349 \subsection{Support code for type/data declarations}
351 %*********************************************************
354 rnDerivs :: Maybe [RdrName] -> RnMS s (Maybe [Name], FreeVars)
356 rnDerivs Nothing -- derivs not specified
357 = returnRn (Nothing, emptyFVs)
360 = mapRn rn_deriv ds `thenRn` \ derivs ->
361 returnRn (Just derivs, foldl addOneFV emptyFVs derivs)
364 = lookupOccRn clas `thenRn` \ clas_name ->
366 -- Now add extra "occurrences" for things that
367 -- the deriving mechanism will later need in order to
368 -- generate code for this class.
369 case lookupUFM derivingOccurrences clas_name of
370 Nothing -> addErrRn (derivingNonStdClassErr clas_name) `thenRn_`
373 Just occs -> mapRn lookupImplicitOccRn occs `thenRn_`
379 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
380 conDeclName (ConDecl n _ _ _ l) = (n,l)
382 rnConDecl :: RdrNameConDecl -> RnMS s (RenamedConDecl, FreeVars)
383 rnConDecl (ConDecl name tvs cxt details locn)
384 = pushSrcLocRn locn $
385 checkConName name `thenRn_`
386 lookupBndrRn name `thenRn` \ new_name ->
387 bindTyVarsFVRn doc tvs $ \ new_tyvars ->
388 rnContext doc cxt `thenRn` \ (new_context, cxt_fvs) ->
389 rnConDetails doc locn details `thenRn` \ (new_details, det_fvs) ->
390 returnRn (ConDecl new_name new_tyvars new_context new_details locn,
391 cxt_fvs `plusFV` det_fvs)
393 doc = text "the definition of data constructor" <+> quotes (ppr name)
395 rnConDetails doc locn (VanillaCon tys)
396 = mapAndUnzipRn (rnBangTy doc) tys `thenRn` \ (new_tys, fvs_s) ->
397 returnRn (VanillaCon new_tys, plusFVs fvs_s)
399 rnConDetails doc locn (InfixCon ty1 ty2)
400 = rnBangTy doc ty1 `thenRn` \ (new_ty1, fvs1) ->
401 rnBangTy doc ty2 `thenRn` \ (new_ty2, fvs2) ->
402 returnRn (InfixCon new_ty1 new_ty2, fvs1 `plusFV` fvs2)
404 rnConDetails doc locn (NewCon ty mb_field)
405 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
406 rn_field mb_field `thenRn` \ new_mb_field ->
407 returnRn (NewCon new_ty new_mb_field, fvs)
409 rn_field Nothing = returnRn Nothing
411 lookupBndrRn f `thenRn` \ new_f ->
412 returnRn (Just new_f)
414 rnConDetails doc locn (RecCon fields)
415 = checkDupOrQualNames doc field_names `thenRn_`
416 mapAndUnzipRn (rnField doc) fields `thenRn` \ (new_fields, fvs_s) ->
417 returnRn (RecCon new_fields, plusFVs fvs_s)
419 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
421 rnField doc (names, ty)
422 = mapRn lookupBndrRn names `thenRn` \ new_names ->
423 rnBangTy doc ty `thenRn` \ (new_ty, fvs) ->
424 returnRn ((new_names, new_ty), fvs)
426 rnBangTy doc (Banged ty)
427 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
428 returnRn (Banged new_ty, fvs)
430 rnBangTy doc (Unbanged ty)
431 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
432 returnRn (Unbanged new_ty, fvs)
434 rnBangTy doc (Unpacked ty)
435 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
436 returnRn (Unpacked new_ty, fvs)
438 -- This data decl will parse OK
440 -- treating "a" as the constructor.
441 -- It is really hard to make the parser spot this malformation.
442 -- So the renamer has to check that the constructor is legal
444 -- We can get an operator as the constructor, even in the prefix form:
445 -- data T = :% Int Int
446 -- from interface files, which always print in prefix form
449 = checkRn (isRdrDataCon name)
454 %*********************************************************
456 \subsection{Naming a dfun}
458 %*********************************************************
460 Make a name for the dict fun for an instance decl
463 mkDFunName :: RenamedHsType -- Instance type
464 -> Maybe RdrName -- Dfun thing from decl; Nothing <=> source
468 mkDFunName inst_ty maybe_df src_loc
469 = newDFunName cl_occ tycon_occ maybe_df src_loc
471 (cl_occ, tycon_occ) = get_key inst_ty
473 get_key (HsForAllTy _ _ ty) = get_key ty
474 get_key (MonoFunTy _ ty) = get_key ty
475 get_key (MonoDictTy cls (ty:_)) = (nameOccName cls, get_tycon_key ty)
477 get_tycon_key (MonoTyVar tv) = nameOccName (getName tv)
478 get_tycon_key (MonoTyApp ty _) = get_tycon_key ty
479 get_tycon_key (MonoTupleTy tys True) = getOccName (tupleTyCon (length tys))
480 get_tycon_key (MonoTupleTy tys False) = getOccName (unboxedTupleTyCon (length tys))
481 get_tycon_key (MonoListTy _) = getOccName listTyCon
482 get_tycon_key (MonoFunTy _ _) = getOccName funTyCon
486 %*********************************************************
488 \subsection{Support code to rename types}
490 %*********************************************************
493 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS s (RenamedHsType, FreeVars)
494 -- rnHsSigType is used for source-language type signatures,
495 -- which use *implicit* universal quantification.
496 rnHsSigType doc_str ty
497 = rnHsType (text "the type signature for" <+> doc_str) ty
499 rnIfaceType :: SDoc -> RdrNameHsType -> RnMS s RenamedHsType
501 = rnHsType doc ty `thenRn` \ (ty,_) ->
505 rnForAll doc forall_tyvars ctxt ty
506 = bindTyVarsFVRn doc forall_tyvars $ \ new_tyvars ->
507 rnContext doc ctxt `thenRn` \ (new_ctxt, cxt_fvs) ->
508 rnHsType doc ty `thenRn` \ (new_ty, ty_fvs) ->
509 returnRn (mkHsForAllTy new_tyvars new_ctxt new_ty,
510 cxt_fvs `plusFV` ty_fvs)
512 -- Check that each constraint mentions at least one of the forall'd type variables
513 -- Since the forall'd type variables are a subset of the free tyvars
514 -- of the tau-type part, this guarantees that every constraint mentions
515 -- at least one of the free tyvars in ty
516 checkConstraints explicit_forall doc forall_tyvars ctxt ty
517 = mapRn check ctxt `thenRn` \ maybe_ctxt' ->
518 returnRn (catMaybes maybe_ctxt')
519 -- Remove problem ones, to avoid duplicate error message.
522 | forall_mentioned = returnRn (Just ct)
523 | otherwise = addErrRn (ctxtErr explicit_forall doc forall_tyvars ct ty) `thenRn_`
526 forall_mentioned = foldr ((||) . any (`elem` forall_tyvars) . extractHsTyVars)
531 rnHsType :: SDoc -> RdrNameHsType -> RnMS s (RenamedHsType, FreeVars)
533 rnHsType doc (HsForAllTy Nothing ctxt ty)
534 -- From source code (no kinds on tyvars)
535 -- Given the signature C => T we universally quantify
536 -- over FV(T) \ {in-scope-tyvars}
537 = getLocalNameEnv `thenRn` \ name_env ->
539 mentioned_tyvars = extractHsTyVars ty
540 forall_tyvars = filter (not . (`elemFM` name_env)) mentioned_tyvars
542 checkConstraints False doc forall_tyvars ctxt ty `thenRn` \ ctxt' ->
543 rnForAll doc (map UserTyVar forall_tyvars) ctxt' ty
545 rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt ty)
546 -- Explicit quantification.
547 -- Check that the forall'd tyvars are a subset of the
548 -- free tyvars in the tau-type part
549 -- That's only a warning... unless the tyvar is constrained by a
550 -- context in which case it's an error
552 mentioned_tyvars = extractHsTyVars ty
553 constrained_tyvars = [tv | (_,tys) <- ctxt,
555 tv <- extractHsTyVars ty]
556 dubious_guys = filter (`notElem` mentioned_tyvars) forall_tyvar_names
557 (bad_guys, warn_guys) = partition (`elem` constrained_tyvars) dubious_guys
558 forall_tyvar_names = map getTyVarName forall_tyvars
560 mapRn (forAllErr doc ty) bad_guys `thenRn_`
561 mapRn (forAllWarn doc ty) warn_guys `thenRn_`
562 checkConstraints True doc forall_tyvar_names ctxt ty `thenRn` \ ctxt' ->
563 rnForAll doc forall_tyvars ctxt' ty
565 rnHsType doc (MonoTyVar tyvar)
566 = lookupOccRn tyvar `thenRn` \ tyvar' ->
567 returnRn (MonoTyVar tyvar', unitFV tyvar')
569 rnHsType doc (MonoFunTy ty1 ty2)
570 = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
571 rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
572 returnRn (MonoFunTy ty1' ty2', fvs1 `plusFV` fvs2)
574 rnHsType doc (MonoListTy ty)
575 = addImplicitOccRn listTyCon_name `thenRn_`
576 rnHsType doc ty `thenRn` \ (ty', fvs) ->
577 returnRn (MonoListTy ty', fvs `addOneFV` listTyCon_name)
579 rnHsType doc (MonoTupleTy tys boxed)
580 = addImplicitOccRn tup_con_name `thenRn_`
581 rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
582 returnRn (MonoTupleTy tys' boxed, fvs `addOneFV` tup_con_name)
584 tup_con_name = tupleTyCon_name boxed (length tys)
586 rnHsType doc (MonoTyApp ty1 ty2)
587 = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
588 rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
589 returnRn (MonoTyApp ty1' ty2', fvs1 `plusFV` fvs2)
591 rnHsType doc (MonoDictTy clas tys)
592 = lookupOccRn clas `thenRn` \ clas' ->
593 rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
594 returnRn (MonoDictTy clas' tys', fvs `addOneFV` clas')
597 = mapAndUnzipRn (rnHsType doc) tys `thenRn` \ (tys, fvs_s) ->
598 returnRn (tys, plusFVs fvs_s)
603 rnContext :: SDoc -> RdrNameContext -> RnMS s (RenamedContext, FreeVars)
606 = mapAndUnzipRn rn_ctxt ctxt `thenRn` \ (theta, fvs_s) ->
608 (_, dup_asserts) = removeDups cmp_assert theta
610 -- Check for duplicate assertions
611 -- If this isn't an error, then it ought to be:
612 mapRn (addWarnRn . dupClassAssertWarn theta) dup_asserts `thenRn_`
614 returnRn (theta, plusFVs fvs_s)
617 = lookupOccRn clas `thenRn` \ clas_name ->
618 rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
619 returnRn ((clas_name, tys'), fvs `addOneFV` clas_name)
621 cmp_assert (c1,tys1) (c2,tys2)
622 = (c1 `compare` c2) `thenCmp` (cmpHsTypes compare tys1 tys2)
626 %*********************************************************
630 %*********************************************************
633 rnIdInfo (HsStrictness strict)
634 = rnStrict strict `thenRn` \ strict' ->
635 returnRn (HsStrictness strict')
637 rnIdInfo (HsUnfold inline (Just expr)) = rnCoreExpr expr `thenRn` \ expr' ->
638 returnRn (HsUnfold inline (Just expr'))
639 rnIdInfo (HsUnfold inline Nothing) = returnRn (HsUnfold inline Nothing)
640 rnIdInfo (HsArity arity) = returnRn (HsArity arity)
641 rnIdInfo (HsUpdate update) = returnRn (HsUpdate update)
642 rnIdInfo (HsNoCafRefs) = returnRn (HsNoCafRefs)
643 rnIdInfo (HsCprInfo cpr_info) = returnRn (HsCprInfo cpr_info)
644 rnIdInfo (HsSpecialise tyvars tys expr)
645 = bindTyVarsRn doc tyvars $ \ tyvars' ->
646 rnCoreExpr expr `thenRn` \ expr' ->
647 mapRn (rnIfaceType doc) tys `thenRn` \ tys' ->
648 returnRn (HsSpecialise tyvars' tys' expr')
650 doc = text "Specialise in interface pragma"
653 rnStrict (HsStrictnessInfo demands (Just (worker,cons)))
654 -- The sole purpose of the "cons" field is so that we can mark the constructors
655 -- needed to build the wrapper as "needed", so that their data type decl will be
656 -- slurped in. After that their usefulness is o'er, so we just put in the empty list.
657 = lookupOccRn worker `thenRn` \ worker' ->
658 mapRn lookupOccRn cons `thenRn_`
659 returnRn (HsStrictnessInfo demands (Just (worker',[])))
661 -- Boring, but necessary for the type checker.
662 rnStrict (HsStrictnessInfo demands Nothing) = returnRn (HsStrictnessInfo demands Nothing)
663 rnStrict HsBottom = returnRn HsBottom
669 rnCoreExpr (UfType ty)
670 = rnIfaceType (text "unfolding type") ty `thenRn` \ ty' ->
671 returnRn (UfType ty')
674 = lookupOccRn v `thenRn` \ v' ->
677 rnCoreExpr (UfCon con args)
678 = rnUfCon con `thenRn` \ con' ->
679 mapRn rnCoreExpr args `thenRn` \ args' ->
680 returnRn (UfCon con' args')
682 rnCoreExpr (UfTuple con args)
683 = lookupOccRn con `thenRn` \ con' ->
684 mapRn rnCoreExpr args `thenRn` \ args' ->
685 returnRn (UfTuple con' args')
687 rnCoreExpr (UfApp fun arg)
688 = rnCoreExpr fun `thenRn` \ fun' ->
689 rnCoreExpr arg `thenRn` \ arg' ->
690 returnRn (UfApp fun' arg')
692 rnCoreExpr (UfCase scrut bndr alts)
693 = rnCoreExpr scrut `thenRn` \ scrut' ->
694 bindLocalsRn "a UfCase" [bndr] $ \ [bndr'] ->
695 mapRn rnCoreAlt alts `thenRn` \ alts' ->
696 returnRn (UfCase scrut' bndr' alts')
698 rnCoreExpr (UfNote note expr)
699 = rnNote note `thenRn` \ note' ->
700 rnCoreExpr expr `thenRn` \ expr' ->
701 returnRn (UfNote note' expr')
703 rnCoreExpr (UfLam bndr body)
704 = rnCoreBndr bndr $ \ bndr' ->
705 rnCoreExpr body `thenRn` \ body' ->
706 returnRn (UfLam bndr' body')
708 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
709 = rnCoreExpr rhs `thenRn` \ rhs' ->
710 rnCoreBndr bndr $ \ bndr' ->
711 rnCoreExpr body `thenRn` \ body' ->
712 returnRn (UfLet (UfNonRec bndr' rhs') body')
714 rnCoreExpr (UfLet (UfRec pairs) body)
715 = rnCoreBndrs bndrs $ \ bndrs' ->
716 mapRn rnCoreExpr rhss `thenRn` \ rhss' ->
717 rnCoreExpr body `thenRn` \ body' ->
718 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
720 (bndrs, rhss) = unzip pairs
724 rnCoreBndr (UfValBinder name ty) thing_inside
725 = rnIfaceType (text str) ty `thenRn` \ ty' ->
726 bindLocalsRn str [name] $ \ [name'] ->
727 thing_inside (UfValBinder name' ty')
731 rnCoreBndr (UfTyBinder name kind) thing_inside
732 = bindLocalsRn "an unfolding tyvar" [name] $ \ [name'] ->
733 thing_inside (UfTyBinder name' kind)
735 rnCoreBndrs bndrs thing_inside -- Expect them all to be ValBinders
736 = mapRn (rnIfaceType (text str)) tys `thenRn` \ tys' ->
737 bindLocalsRn str names $ \ names' ->
738 thing_inside (zipWith UfValBinder names' tys')
741 names = map (\ (UfValBinder name _ ) -> name) bndrs
742 tys = map (\ (UfValBinder _ ty) -> ty) bndrs
746 rnCoreAlt (con, bndrs, rhs)
747 = rnUfCon con `thenRn` \ con' ->
748 bindLocalsRn "an unfolding alt" bndrs $ \ bndrs' ->
749 rnCoreExpr rhs `thenRn` \ rhs' ->
750 returnRn (con', bndrs', rhs')
754 = rnIfaceType (text "unfolding coerce") ty `thenRn` \ ty' ->
755 returnRn (UfCoerce ty')
757 rnNote (UfSCC cc) = returnRn (UfSCC cc)
758 rnNote UfInlineCall = returnRn UfInlineCall
764 rnUfCon (UfDataCon con)
765 = lookupOccRn con `thenRn` \ con' ->
766 returnRn (UfDataCon con')
768 rnUfCon (UfLitCon lit)
769 = returnRn (UfLitCon lit)
771 rnUfCon (UfLitLitCon lit ty)
772 = rnIfaceType (text "litlit") ty `thenRn` \ ty' ->
773 returnRn (UfLitLitCon lit ty')
775 rnUfCon (UfPrimOp op)
776 = lookupOccRn op `thenRn` \ op' ->
777 returnRn (UfPrimOp op')
779 rnUfCon (UfCCallOp str is_dyn casm gc)
780 = returnRn (UfCCallOp str is_dyn casm gc)
783 %*********************************************************
787 %*********************************************************
790 derivingNonStdClassErr clas
791 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
793 classTyVarNotInOpTyErr clas_tyvar sig
794 = hang (hsep [ptext SLIT("Class type variable"),
795 quotes (ppr clas_tyvar),
796 ptext SLIT("does not appear in method signature")])
799 dupClassAssertWarn ctxt (assertion : dups)
800 = sep [hsep [ptext SLIT("Duplicate class assertion"),
801 quotes (pprClassAssertion assertion),
802 ptext SLIT("in the context:")],
803 nest 4 (pprContext ctxt <+> ptext SLIT("..."))]
806 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
808 forAllWarn doc ty tyvar
809 | not opt_WarnUnusedMatches = returnRn ()
812 sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
813 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
815 (ptext SLIT("In") <+> doc))
817 forAllErr doc ty tyvar
819 sep [ptext SLIT("The constrained type variable") <+> quotes (ppr tyvar),
820 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
822 (ptext SLIT("In") <+> doc))
824 ctxtErr explicit_forall doc tyvars constraint ty
825 = sep [ptext SLIT("The constraint") <+> quotes (pprClassAssertion constraint) <+>
826 ptext SLIT("does not mention any of"),
827 if explicit_forall then
828 nest 4 (ptext SLIT("the universally quantified type variables") <+> braces (interpp'SP tyvars))
830 nest 4 (ptext SLIT("the type variables in the type") <+> quotes (ppr ty))
833 (ptext SLIT("In") <+> doc)