2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
7 module RnSource ( rnDecl, rnSourceDecls, rnHsType, rnHsSigType ) where
9 #include "HsVersions.h"
14 import HsTypes ( getTyVarName, pprClassAssertion, cmpHsTypes )
15 import RdrName ( RdrName, isRdrDataCon, rdrNameOcc, isRdrTyVar )
16 import RdrHsSyn ( RdrNameContext, RdrNameHsType, RdrNameConDecl,
17 extractHsTyRdrNames, extractRuleBndrsTyVars
22 import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs, unknownSigErr )
23 import RnEnv ( bindTyVarsRn, lookupBndrRn, lookupOccRn,
25 bindLocalsRn, bindLocalRn, bindLocalsFVRn,
26 bindTyVarsFVRn, bindTyVarsFV2Rn, extendTyVarEnvFVRn,
27 bindCoreLocalFVRn, bindCoreLocalsFVRn,
28 checkDupOrQualNames, checkDupNames,
29 mkImportedGlobalName, mkImportedGlobalFromRdrName,
30 newDFunName, getDFunKey, newImplicitBinder,
31 FreeVars, emptyFVs, plusFV, plusFVs, unitFV, addOneFV, mapFvRn
35 import Name ( Name, OccName,
36 ExportFlag(..), Provenance(..),
37 nameOccName, NamedThing(..)
40 import OccName ( mkDefaultMethodOcc )
41 import BasicTypes ( TopLevelFlag(..) )
42 import FiniteMap ( elemFM )
43 import PrelInfo ( derivingOccurrences, numClass_RDR,
44 deRefStablePtr_NAME, makeStablePtr_NAME,
47 import Bag ( bagToList )
48 import List ( partition, nub )
50 import SrcLoc ( SrcLoc )
51 import CmdLineOpts ( opt_WarnUnusedMatches ) -- Warn of unused for-all'd tyvars
52 import UniqFM ( lookupUFM )
53 import Maybes ( maybeToBool, catMaybes )
57 rnDecl `renames' declarations.
58 It simultaneously performs dependency analysis and precedence parsing.
59 It also does the following error checks:
62 Checks that tyvars are used properly. This includes checking
63 for undefined tyvars, and tyvars in contexts that are ambiguous.
65 Checks that all variable occurences are defined.
67 Checks the (..) etc constraints in the export list.
71 %*********************************************************
73 \subsection{Value declarations}
75 %*********************************************************
78 rnSourceDecls :: [RdrNameHsDecl] -> RnMS ([RenamedHsDecl], FreeVars)
79 -- The decls get reversed, but that's ok
82 = go emptyFVs [] decls
84 -- Fixity decls have been dealt with already; ignore them
85 go fvs ds' [] = returnRn (ds', fvs)
86 go fvs ds' (FixD _:ds) = go fvs ds' ds
87 go fvs ds' (d:ds) = rnDecl d `thenRn` \(d', fvs') ->
88 go (fvs `plusFV` fvs') (d':ds') ds
92 %*********************************************************
94 \subsection{Value declarations}
96 %*********************************************************
99 -- rnDecl does all the work
100 rnDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
102 rnDecl (ValD binds) = rnTopBinds binds `thenRn` \ (new_binds, fvs) ->
103 returnRn (ValD new_binds, fvs)
106 rnDecl (SigD (IfaceSig name ty id_infos loc))
108 lookupBndrRn name `thenRn` \ name' ->
109 rnHsType doc_str ty `thenRn` \ (ty',fvs1) ->
110 mapFvRn rnIdInfo id_infos `thenRn` \ (id_infos', fvs2) ->
111 returnRn (SigD (IfaceSig name' ty' id_infos' loc), fvs1 `plusFV` fvs2)
113 doc_str = text "the interface signature for" <+> quotes (ppr name)
116 %*********************************************************
118 \subsection{Type declarations}
120 %*********************************************************
122 @rnTyDecl@ uses the `global name function' to create a new type
123 declaration in which local names have been replaced by their original
124 names, reporting any unknown names.
126 Renaming type variables is a pain. Because they now contain uniques,
127 it is necessary to pass in an association list which maps a parsed
128 tyvar to its Name representation. In some cases (type signatures of
129 values), it is even necessary to go over the type first in order to
130 get the set of tyvars used by it, make an assoc list, and then go over
131 it again to rename the tyvars! However, we can also do some scoping
132 checks at the same time.
135 rnDecl (TyClD (TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc))
136 = pushSrcLocRn src_loc $
137 lookupBndrRn tycon `thenRn` \ tycon' ->
138 bindTyVarsFVRn data_doc tyvars $ \ tyvars' ->
139 rnContext data_doc context `thenRn` \ (context', cxt_fvs) ->
140 checkDupOrQualNames data_doc con_names `thenRn_`
141 mapFvRn rnConDecl condecls `thenRn` \ (condecls', con_fvs) ->
142 rnDerivs derivings `thenRn` \ (derivings', deriv_fvs) ->
143 ASSERT(isNoDataPragmas pragmas)
144 returnRn (TyClD (TyData new_or_data context' tycon' tyvars' condecls' derivings' noDataPragmas src_loc),
145 cxt_fvs `plusFV` con_fvs `plusFV` deriv_fvs)
147 data_doc = text "the data type declaration for" <+> quotes (ppr tycon)
148 con_names = map conDeclName condecls
150 rnDecl (TyClD (TySynonym name tyvars ty src_loc))
151 = pushSrcLocRn src_loc $
152 lookupBndrRn name `thenRn` \ name' ->
153 bindTyVarsFVRn syn_doc tyvars $ \ tyvars' ->
154 rnHsType syn_doc ty `thenRn` \ (ty', ty_fvs) ->
155 returnRn (TyClD (TySynonym name' tyvars' ty' src_loc), ty_fvs)
157 syn_doc = text "the declaration for type synonym" <+> quotes (ppr name)
159 rnDecl (TyClD (ClassDecl context cname tyvars sigs mbinds pragmas tname dname snames src_loc))
160 = pushSrcLocRn src_loc $
162 lookupBndrRn cname `thenRn` \ cname' ->
164 -- Deal with the implicit tycon and datacon name
165 -- They aren't in scope (because they aren't visible to the user)
166 -- and what we want to do is simply look them up in the cache;
167 -- we jolly well ought to get a 'hit' there!
168 -- So the 'Imported' part of this call is not relevant.
169 -- Unclean; but since these two are the only place this happens
170 -- I can't work up the energy to do it more beautifully
171 mkImportedGlobalFromRdrName tname `thenRn` \ tname' ->
172 mkImportedGlobalFromRdrName dname `thenRn` \ dname' ->
173 mapRn mkImportedGlobalFromRdrName snames `thenRn` \ snames' ->
175 -- Tyvars scope over bindings and context
176 bindTyVarsFV2Rn cls_doc tyvars ( \ clas_tyvar_names tyvars' ->
178 -- Check the superclasses
179 rnContext cls_doc context `thenRn` \ (context', cxt_fvs) ->
181 -- Check the signatures
183 -- First process the class op sigs, then the fixity sigs.
184 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
185 (fix_sigs, non_sigs) = partition isFixitySig non_op_sigs
187 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
188 mapFvRn (rn_op cname' clas_tyvar_names) op_sigs `thenRn` \ (sigs', sig_fvs) ->
189 mapRn_ (unknownSigErr) non_sigs `thenRn_`
191 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
193 renameSigs False binders lookupOccRn fix_sigs `thenRn` \ (fixs', fix_fvs) ->
196 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
197 rnMethodBinds mbinds `thenRn` \ (mbinds', meth_fvs) ->
199 -- Typechecker is responsible for checking that we only
200 -- give default-method bindings for things in this class.
201 -- The renamer *could* check this for class decls, but can't
202 -- for instance decls.
204 ASSERT(isNoClassPragmas pragmas)
205 returnRn (TyClD (ClassDecl context' cname' tyvars' (fixs' ++ sigs')
206 mbinds' NoClassPragmas tname' dname' snames' src_loc),
214 cls_doc = text "the declaration for class" <+> ppr cname
215 sig_doc = text "the signatures for class" <+> ppr cname
216 meth_doc = text "the default-methods for class" <+> ppr cname
218 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
219 meth_rdr_names_w_locs = bagToList (collectMonoBinders mbinds)
220 meth_rdr_names = map fst meth_rdr_names_w_locs
222 rn_op clas clas_tyvars sig@(ClassOpSig op maybe_dm ty locn)
223 = pushSrcLocRn locn $
224 lookupBndrRn op `thenRn` \ op_name ->
226 -- Check the signature
227 rnHsSigType (quotes (ppr op)) ty `thenRn` \ (new_ty, op_ty_fvs) ->
229 check_in_op_ty clas_tyvar = checkRn (clas_tyvar `elemNameSet` op_ty_fvs)
230 (classTyVarNotInOpTyErr clas_tyvar sig)
232 mapRn_ check_in_op_ty clas_tyvars `thenRn_`
234 -- Make the default-method name
235 getModeRn `thenRn` \ mode ->
236 (case (mode, maybe_dm) of
238 | op `elem` meth_rdr_names
239 -> -- Source class decl with an explicit method decl
240 newImplicitBinder (mkDefaultMethodOcc (rdrNameOcc op)) locn `thenRn` \ dm_name ->
241 returnRn (Just dm_name, emptyFVs)
244 -> -- Source class dec, no explicit method decl
245 returnRn (Nothing, emptyFVs)
247 (InterfaceMode, Just dm_rdr_name)
248 -> -- Imported class that has a default method decl
249 -- See comments with tname, snames, above
250 lookupImplicitOccRn dm_rdr_name `thenRn` \ dm_name ->
251 returnRn (Just dm_name, unitFV dm_name)
252 -- An imported class decl mentions, rather than defines,
253 -- the default method, so we must arrange to pull it in
255 (InterfaceMode, Nothing)
256 -- Imported class with no default metho
257 -> returnRn (Nothing, emptyFVs)
258 ) `thenRn` \ (maybe_dm_name, dm_fvs) ->
260 returnRn (ClassOpSig op_name maybe_dm_name new_ty locn, op_ty_fvs `plusFV` dm_fvs)
264 %*********************************************************
266 \subsection{Instance declarations}
268 %*********************************************************
271 rnDecl (InstD (InstDecl inst_ty mbinds uprags dfun_rdr_name 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
282 -- Rename the bindings
283 -- NB meth_names can be qualified!
284 checkDupNames meth_doc meth_names `thenRn_`
285 extendTyVarEnvFVRn inst_tyvars (
287 ) `thenRn` \ (mbinds', meth_fvs) ->
289 binders = mkNameSet (map fst (bagToList (collectMonoBinders mbinds')))
291 -- Delete sigs (&report) sigs that aren't allowed inside an
297 (ok_sigs, not_ok_idecl_sigs) = partition okInInstDecl uprags
299 okInInstDecl (FixSig _) = False
300 okInInstDecl (Sig _ _ _) = False
301 okInInstDecl _ = True
304 -- You can't have fixity decls & type signatures
305 -- within an instance declaration.
306 mapRn_ unknownSigErr not_ok_idecl_sigs `thenRn_`
308 -- Rename the prags and signatures.
309 -- Note that the type variables are not in scope here,
310 -- so that instance Eq a => Eq (T a) where
311 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
313 renameSigs False binders lookupOccRn ok_sigs `thenRn` \ (new_uprags, prag_fvs) ->
315 getModeRn `thenRn` \ mode ->
317 InterfaceMode -> lookupImplicitOccRn dfun_rdr_name `thenRn` \ dfun_name ->
318 returnRn (dfun_name, unitFV dfun_name)
319 SourceMode -> newDFunName (getDFunKey inst_ty') src_loc `thenRn` \ dfun_name ->
320 returnRn (dfun_name, emptyFVs)
321 ) `thenRn` \ (dfun_name, dfun_fv) ->
323 -- The typechecker checks that all the bindings are for the right class.
324 returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags dfun_name src_loc),
325 inst_fvs `plusFV` meth_fvs `plusFV` prag_fvs `plusFV` dfun_fv)
327 meth_doc = text "the bindings in an instance declaration"
328 meth_names = bagToList (collectMonoBinders mbinds)
331 %*********************************************************
333 \subsection{Default declarations}
335 %*********************************************************
338 rnDecl (DefD (DefaultDecl tys src_loc))
339 = pushSrcLocRn src_loc $
340 rnHsTypes doc_str tys `thenRn` \ (tys', fvs) ->
341 lookupImplicitOccRn numClass_RDR `thenRn` \ num ->
342 returnRn (DefD (DefaultDecl tys' src_loc), fvs `addOneFV` num)
344 doc_str = text "a `default' declaration"
347 %*********************************************************
349 \subsection{Foreign declarations}
351 %*********************************************************
354 rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
355 = pushSrcLocRn src_loc $
356 lookupBndrRn name `thenRn` \ name' ->
358 fvs1 = case imp_exp of
359 FoImport _ | not isDyn -> emptyFVs
361 FoExport | isDyn -> mkNameSet [makeStablePtr_NAME,
366 rnHsSigType fo_decl_msg ty `thenRn` \ (ty', fvs2) ->
367 returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc),
370 fo_decl_msg = ptext SLIT("a foreign declaration")
371 isDyn = isDynamic ext_nm
374 %*********************************************************
378 %*********************************************************
381 rnDecl (RuleD (IfaceRuleDecl var body src_loc))
382 = pushSrcLocRn src_loc $
383 lookupOccRn var `thenRn` \ var' ->
384 rnRuleBody body `thenRn` \ (body', fvs) ->
385 returnRn (RuleD (IfaceRuleDecl var' body' src_loc), fvs `addOneFV` var')
387 rnDecl (RuleD (RuleDecl rule_name tvs vars lhs rhs src_loc))
389 pushSrcLocRn src_loc $
391 bindTyVarsFV2Rn doc (map UserTyVar sig_tvs) $ \ sig_tvs' _ ->
392 bindLocalsFVRn doc (map get_var vars) $ \ ids ->
393 mapFvRn rn_var (vars `zip` ids) `thenRn` \ (vars', fv_vars) ->
395 rnExpr lhs `thenRn` \ (lhs', fv_lhs) ->
396 rnExpr rhs `thenRn` \ (rhs', fv_rhs) ->
397 checkRn (validRuleLhs ids lhs')
398 (badRuleLhsErr rule_name lhs') `thenRn_`
400 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
402 mapRn (addErrRn . badRuleVar rule_name) bad_vars `thenRn_`
403 returnRn (RuleD (RuleDecl rule_name sig_tvs' vars' lhs' rhs' src_loc),
404 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
406 doc = text "the transformation rule" <+> ptext rule_name
407 sig_tvs = extractRuleBndrsTyVars vars
409 get_var (RuleBndr v) = v
410 get_var (RuleBndrSig v _) = v
412 rn_var (RuleBndr v, id) = returnRn (RuleBndr id, emptyFVs)
413 rn_var (RuleBndrSig v t, id) = rnHsType doc t `thenRn` \ (t', fvs) ->
414 returnRn (RuleBndrSig id t', fvs)
418 %*********************************************************
420 \subsection{Support code for type/data declarations}
422 %*********************************************************
425 rnDerivs :: Maybe [RdrName] -> RnMS (Maybe [Name], FreeVars)
427 rnDerivs Nothing -- derivs not specified
428 = returnRn (Nothing, emptyFVs)
431 = mapFvRn rn_deriv ds `thenRn` \ (derivs, fvs) ->
432 returnRn (Just derivs, fvs)
435 = lookupOccRn clas `thenRn` \ clas_name ->
437 -- Now add extra "occurrences" for things that
438 -- the deriving mechanism will later need in order to
439 -- generate code for this class.
440 case lookupUFM derivingOccurrences clas_name of
441 Nothing -> addErrRn (derivingNonStdClassErr clas_name) `thenRn_`
442 returnRn (clas_name, unitFV clas_name)
444 Just occs -> mapRn lookupImplicitOccRn occs `thenRn` \ names ->
445 returnRn (clas_name, mkNameSet (clas_name : names))
449 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
450 conDeclName (ConDecl n _ _ _ l) = (n,l)
452 rnConDecl :: RdrNameConDecl -> RnMS (RenamedConDecl, FreeVars)
453 rnConDecl (ConDecl name tvs cxt details locn)
454 = pushSrcLocRn locn $
455 checkConName name `thenRn_`
456 lookupBndrRn name `thenRn` \ new_name ->
457 bindTyVarsFVRn doc tvs $ \ new_tyvars ->
458 rnContext doc cxt `thenRn` \ (new_context, cxt_fvs) ->
459 rnConDetails doc locn details `thenRn` \ (new_details, det_fvs) ->
460 returnRn (ConDecl new_name new_tyvars new_context new_details locn,
461 cxt_fvs `plusFV` det_fvs)
463 doc = text "the definition of data constructor" <+> quotes (ppr name)
465 rnConDetails doc locn (VanillaCon tys)
466 = mapFvRn (rnBangTy doc) tys `thenRn` \ (new_tys, fvs) ->
467 returnRn (VanillaCon new_tys, fvs)
469 rnConDetails doc locn (InfixCon ty1 ty2)
470 = rnBangTy doc ty1 `thenRn` \ (new_ty1, fvs1) ->
471 rnBangTy doc ty2 `thenRn` \ (new_ty2, fvs2) ->
472 returnRn (InfixCon new_ty1 new_ty2, fvs1 `plusFV` fvs2)
474 rnConDetails doc locn (NewCon ty mb_field)
475 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
476 rn_field mb_field `thenRn` \ new_mb_field ->
477 returnRn (NewCon new_ty new_mb_field, fvs)
479 rn_field Nothing = returnRn Nothing
481 lookupBndrRn f `thenRn` \ new_f ->
482 returnRn (Just new_f)
484 rnConDetails doc locn (RecCon fields)
485 = checkDupOrQualNames doc field_names `thenRn_`
486 mapFvRn (rnField doc) fields `thenRn` \ (new_fields, fvs) ->
487 returnRn (RecCon new_fields, fvs)
489 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
491 rnField doc (names, ty)
492 = mapRn lookupBndrRn names `thenRn` \ new_names ->
493 rnBangTy doc ty `thenRn` \ (new_ty, fvs) ->
494 returnRn ((new_names, new_ty), fvs)
496 rnBangTy doc (Banged ty)
497 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
498 returnRn (Banged new_ty, fvs)
500 rnBangTy doc (Unbanged ty)
501 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
502 returnRn (Unbanged new_ty, fvs)
504 rnBangTy doc (Unpacked ty)
505 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
506 returnRn (Unpacked new_ty, fvs)
508 -- This data decl will parse OK
510 -- treating "a" as the constructor.
511 -- It is really hard to make the parser spot this malformation.
512 -- So the renamer has to check that the constructor is legal
514 -- We can get an operator as the constructor, even in the prefix form:
515 -- data T = :% Int Int
516 -- from interface files, which always print in prefix form
519 = checkRn (isRdrDataCon name)
524 %*********************************************************
526 \subsection{Support code to rename types}
528 %*********************************************************
531 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
532 -- rnHsSigType is used for source-language type signatures,
533 -- which use *implicit* universal quantification.
534 rnHsSigType doc_str ty
535 = rnHsType (text "the type signature for" <+> doc_str) ty
537 rnForAll doc forall_tyvars ctxt ty
538 = bindTyVarsFVRn doc forall_tyvars $ \ new_tyvars ->
539 rnContext doc ctxt `thenRn` \ (new_ctxt, cxt_fvs) ->
540 rnHsType doc ty `thenRn` \ (new_ty, ty_fvs) ->
541 returnRn (mkHsForAllTy new_tyvars new_ctxt new_ty,
542 cxt_fvs `plusFV` ty_fvs)
544 -- Check that each constraint mentions at least one of the forall'd type variables
545 -- Since the forall'd type variables are a subset of the free tyvars
546 -- of the tau-type part, this guarantees that every constraint mentions
547 -- at least one of the free tyvars in ty
548 checkConstraints explicit_forall doc forall_tyvars ctxt ty
549 = mapRn check ctxt `thenRn` \ maybe_ctxt' ->
550 returnRn (catMaybes maybe_ctxt')
551 -- Remove problem ones, to avoid duplicate error message.
554 | forall_mentioned = returnRn (Just ct)
555 | otherwise = addErrRn (ctxtErr explicit_forall doc forall_tyvars ct ty) `thenRn_`
558 forall_mentioned = foldr ((||) . any (`elem` forall_tyvars) . extractHsTyRdrNames)
562 freeRdrTyVars :: RdrNameHsType -> [RdrName]
563 freeRdrTyVars ty = filter isRdrTyVar (extractHsTyRdrNames ty)
565 rnHsType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
567 rnHsType doc (HsForAllTy Nothing ctxt ty)
568 -- From source code (no kinds on tyvars)
569 -- Given the signature C => T we universally quantify
570 -- over FV(T) \ {in-scope-tyvars}
571 = getLocalNameEnv `thenRn` \ name_env ->
573 mentioned_in_tau = freeRdrTyVars ty
574 forall_tyvars = filter (not . (`elemFM` name_env)) mentioned_in_tau
576 checkConstraints False doc forall_tyvars ctxt ty `thenRn` \ ctxt' ->
577 rnForAll doc (map UserTyVar forall_tyvars) ctxt' ty
579 rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
580 -- Explicit quantification.
581 -- Check that the forall'd tyvars are a subset of the
582 -- free tyvars in the tau-type part
583 -- That's only a warning... unless the tyvar is constrained by a
584 -- context in which case it's an error
586 mentioned_in_tau = freeRdrTyVars tau
587 mentioned_in_ctxt = nub [tv | (_,tys) <- ctxt,
589 tv <- freeRdrTyVars ty]
591 dubious_guys = filter (`notElem` mentioned_in_tau) forall_tyvar_names
592 -- dubious = explicitly quantified but not mentioned in tau type
594 (bad_guys, warn_guys) = partition (`elem` mentioned_in_ctxt) dubious_guys
595 -- bad = explicitly quantified and constrained, but not mentioned in tau
596 -- warn = explicitly quantified but not mentioned in ctxt or tau
598 forall_tyvar_names = map getTyVarName forall_tyvars
600 mapRn_ (forAllErr doc tau) bad_guys `thenRn_`
601 mapRn_ (forAllWarn doc tau) warn_guys `thenRn_`
602 checkConstraints True doc forall_tyvar_names ctxt tau `thenRn` \ ctxt' ->
603 rnForAll doc forall_tyvars ctxt' tau
605 rnHsType doc (MonoTyVar tyvar)
606 = lookupOccRn tyvar `thenRn` \ tyvar' ->
607 returnRn (MonoTyVar tyvar', unitFV tyvar')
609 rnHsType doc (MonoFunTy ty1 ty2)
610 = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
611 rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
612 returnRn (MonoFunTy ty1' ty2', fvs1 `plusFV` fvs2)
614 rnHsType doc (MonoListTy ty)
615 = rnHsType doc ty `thenRn` \ (ty', fvs) ->
616 returnRn (MonoListTy ty', fvs `addOneFV` listTyCon_name)
618 rnHsType doc (MonoTupleTy tys boxed)
619 = rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
620 returnRn (MonoTupleTy tys' boxed, fvs `addOneFV` tup_con_name)
622 tup_con_name = tupleTyCon_name boxed (length tys)
624 rnHsType doc (MonoTyApp ty1 ty2)
625 = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
626 rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
627 returnRn (MonoTyApp ty1' ty2', fvs1 `plusFV` fvs2)
629 rnHsType doc (MonoDictTy clas tys)
630 = lookupOccRn clas `thenRn` \ clas' ->
631 rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
632 returnRn (MonoDictTy clas' tys', fvs `addOneFV` clas')
634 rnHsType doc (MonoUsgTy usg ty)
635 = rnHsType doc ty `thenRn` \ (ty', fvs) ->
636 returnRn (MonoUsgTy usg ty', fvs)
638 rnHsTypes doc tys = mapFvRn (rnHsType doc) tys
643 rnContext :: SDoc -> RdrNameContext -> RnMS (RenamedContext, FreeVars)
646 = mapAndUnzipRn rn_ctxt ctxt `thenRn` \ (theta, fvs_s) ->
648 (_, dup_asserts) = removeDups cmp_assert theta
650 -- Check for duplicate assertions
651 -- If this isn't an error, then it ought to be:
652 mapRn_ (addWarnRn . dupClassAssertWarn theta) dup_asserts `thenRn_`
654 returnRn (theta, plusFVs fvs_s)
657 = lookupOccRn clas `thenRn` \ clas_name ->
658 rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
659 returnRn ((clas_name, tys'), fvs `addOneFV` clas_name)
661 cmp_assert (c1,tys1) (c2,tys2)
662 = (c1 `compare` c2) `thenCmp` (cmpHsTypes compare tys1 tys2)
666 %*********************************************************
670 %*********************************************************
673 rnIdInfo (HsStrictness str) = returnRn (HsStrictness str, emptyFVs)
675 rnIdInfo (HsWorker worker)
676 = lookupOccRn worker `thenRn` \ worker' ->
677 returnRn (HsWorker worker', unitFV worker')
679 rnIdInfo (HsUnfold inline (Just expr)) = rnCoreExpr expr `thenRn` \ (expr', fvs) ->
680 returnRn (HsUnfold inline (Just expr'), fvs)
681 rnIdInfo (HsUnfold inline Nothing) = returnRn (HsUnfold inline Nothing, emptyFVs)
682 rnIdInfo (HsArity arity) = returnRn (HsArity arity, emptyFVs)
683 rnIdInfo (HsUpdate update) = returnRn (HsUpdate update, emptyFVs)
684 rnIdInfo (HsNoCafRefs) = returnRn (HsNoCafRefs, emptyFVs)
685 rnIdInfo (HsCprInfo cpr_info) = returnRn (HsCprInfo cpr_info, emptyFVs)
686 rnIdInfo (HsSpecialise rule_body) = rnRuleBody rule_body `thenRn` \ (rule_body', fvs) ->
687 returnRn (HsSpecialise rule_body', fvs)
689 rnRuleBody (UfRuleBody str vars args rhs)
690 = rnCoreBndrs vars $ \ vars' ->
691 mapFvRn rnCoreExpr args `thenRn` \ (args', fvs1) ->
692 rnCoreExpr rhs `thenRn` \ (rhs', fvs2) ->
693 returnRn (UfRuleBody str vars' args' rhs', fvs1 `plusFV` fvs2)
699 rnCoreExpr (UfType ty)
700 = rnHsType (text "unfolding type") ty `thenRn` \ (ty', fvs) ->
701 returnRn (UfType ty', fvs)
704 = lookupOccRn v `thenRn` \ v' ->
705 returnRn (UfVar v', unitFV v')
707 rnCoreExpr (UfCon con args)
708 = rnUfCon con `thenRn` \ (con', fvs1) ->
709 mapFvRn rnCoreExpr args `thenRn` \ (args', fvs2) ->
710 returnRn (UfCon con' args', fvs1 `plusFV` fvs2)
712 rnCoreExpr (UfTuple con args)
713 = lookupOccRn con `thenRn` \ con' ->
714 mapFvRn rnCoreExpr args `thenRn` \ (args', fvs) ->
715 returnRn (UfTuple con' args', fvs `addOneFV` con')
717 rnCoreExpr (UfApp fun arg)
718 = rnCoreExpr fun `thenRn` \ (fun', fv1) ->
719 rnCoreExpr arg `thenRn` \ (arg', fv2) ->
720 returnRn (UfApp fun' arg', fv1 `plusFV` fv2)
722 rnCoreExpr (UfCase scrut bndr alts)
723 = rnCoreExpr scrut `thenRn` \ (scrut', fvs1) ->
724 bindCoreLocalFVRn bndr ( \ bndr' ->
725 mapFvRn rnCoreAlt alts `thenRn` \ (alts', fvs2) ->
726 returnRn (UfCase scrut' bndr' alts', fvs2)
727 ) `thenRn` \ (case', fvs3) ->
728 returnRn (case', fvs1 `plusFV` fvs3)
730 rnCoreExpr (UfNote note expr)
731 = rnNote note `thenRn` \ (note', fvs1) ->
732 rnCoreExpr expr `thenRn` \ (expr', fvs2) ->
733 returnRn (UfNote note' expr', fvs1 `plusFV` fvs2)
735 rnCoreExpr (UfLam bndr body)
736 = rnCoreBndr bndr $ \ bndr' ->
737 rnCoreExpr body `thenRn` \ (body', fvs) ->
738 returnRn (UfLam bndr' body', fvs)
740 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
741 = rnCoreExpr rhs `thenRn` \ (rhs', fvs1) ->
742 rnCoreBndr bndr ( \ bndr' ->
743 rnCoreExpr body `thenRn` \ (body', fvs2) ->
744 returnRn (UfLet (UfNonRec bndr' rhs') body', fvs2)
745 ) `thenRn` \ (result, fvs3) ->
746 returnRn (result, fvs1 `plusFV` fvs3)
748 rnCoreExpr (UfLet (UfRec pairs) body)
749 = rnCoreBndrs bndrs $ \ bndrs' ->
750 mapFvRn rnCoreExpr rhss `thenRn` \ (rhss', fvs1) ->
751 rnCoreExpr body `thenRn` \ (body', fvs2) ->
752 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body', fvs1 `plusFV` fvs2)
754 (bndrs, rhss) = unzip pairs
758 rnCoreBndr (UfValBinder name ty) thing_inside
759 = rnHsType doc ty `thenRn` \ (ty', fvs1) ->
760 bindCoreLocalFVRn name ( \ name' ->
761 thing_inside (UfValBinder name' ty')
762 ) `thenRn` \ (result, fvs2) ->
763 returnRn (result, fvs1 `plusFV` fvs2)
765 doc = text "unfolding id"
767 rnCoreBndr (UfTyBinder name kind) thing_inside
768 = bindCoreLocalFVRn name $ \ name' ->
769 thing_inside (UfTyBinder name' kind)
771 rnCoreBndrs [] thing_inside = thing_inside []
772 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
773 rnCoreBndrs bs $ \ names' ->
774 thing_inside (name':names')
778 rnCoreAlt (con, bndrs, rhs)
779 = rnUfCon con `thenRn` \ (con', fvs1) ->
780 bindCoreLocalsFVRn bndrs ( \ bndrs' ->
781 rnCoreExpr rhs `thenRn` \ (rhs', fvs2) ->
782 returnRn ((con', bndrs', rhs'), fvs2)
783 ) `thenRn` \ (result, fvs3) ->
784 returnRn (result, fvs1 `plusFV` fvs3)
787 = rnHsType (text "unfolding coerce") ty `thenRn` \ (ty', fvs) ->
788 returnRn (UfCoerce ty', fvs)
790 rnNote (UfSCC cc) = returnRn (UfSCC cc, emptyFVs)
791 rnNote UfInlineCall = returnRn (UfInlineCall, emptyFVs)
792 rnNote UfInlineMe = returnRn (UfInlineMe, emptyFVs)
796 = returnRn (UfDefault, emptyFVs)
798 rnUfCon (UfDataCon con)
799 = lookupOccRn con `thenRn` \ con' ->
800 returnRn (UfDataCon con', unitFV con')
802 rnUfCon (UfLitCon lit)
803 = returnRn (UfLitCon lit, emptyFVs)
805 rnUfCon (UfLitLitCon lit ty)
806 = rnHsType (text "litlit") ty `thenRn` \ (ty', fvs) ->
807 returnRn (UfLitLitCon lit ty', fvs)
809 rnUfCon (UfPrimOp op)
810 = lookupOccRn op `thenRn` \ op' ->
811 returnRn (UfPrimOp op', emptyFVs)
813 rnUfCon (UfCCallOp str is_dyn casm gc)
814 = returnRn (UfCCallOp str is_dyn casm gc, emptyFVs)
817 %*********************************************************
819 \subsection{Rule shapes}
821 %*********************************************************
823 Check the shape of a transformation rule LHS. Currently
824 we only allow LHSs of the form (f e1 .. en), where f is
825 not one of the forall'd variables.
828 validRuleLhs foralls lhs
831 check (HsApp e1 e2) = check e1
832 check (HsVar v) | v `notElem` foralls = True
837 %*********************************************************
841 %*********************************************************
844 derivingNonStdClassErr clas
845 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
847 classTyVarNotInOpTyErr clas_tyvar sig
848 = hang (hsep [ptext SLIT("Class type variable"),
849 quotes (ppr clas_tyvar),
850 ptext SLIT("does not appear in method signature")])
853 dupClassAssertWarn ctxt (assertion : dups)
854 = sep [hsep [ptext SLIT("Duplicate class assertion"),
855 quotes (pprClassAssertion assertion),
856 ptext SLIT("in the context:")],
857 nest 4 (pprContext ctxt <+> ptext SLIT("..."))]
860 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
862 forAllWarn doc ty tyvar
863 | not opt_WarnUnusedMatches = returnRn ()
865 = getModeRn `thenRn` \ mode ->
868 InterfaceMode -> returnRn () ; -- Don't warn of unused tyvars in interface files
869 -- unless DEBUG is on, in which case it is slightly
870 -- informative. They can arise from mkRhsTyLam,
871 #endif -- leading to (say) f :: forall a b. [b] -> [b]
875 sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
876 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
878 (ptext SLIT("In") <+> doc))
881 forAllErr doc ty tyvar
883 sep [ptext SLIT("The constrained type variable") <+> quotes (ppr tyvar),
884 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
886 (ptext SLIT("In") <+> doc))
888 ctxtErr explicit_forall doc tyvars constraint ty
889 = sep [ptext SLIT("None of the type variable(s) in the constraint") <+> quotes (pprClassAssertion constraint) <+>
890 ptext SLIT("does not mention any of"),
891 if explicit_forall then
892 nest 4 (ptext SLIT("is universally quantified (i.e. bound by the forall)"))
894 nest 4 (ptext SLIT("appears in the type") <+> quotes (ppr ty))
897 (ptext SLIT("In") <+> doc)
899 badRuleLhsErr name lhs
900 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
901 nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
903 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
906 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
907 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
908 ptext SLIT("does not appear on left hand side")]