2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
7 module RnSource ( rnDecl, rnSourceDecls, rnHsType, rnHsSigType, rnHsPolyType ) 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 extractRuleBndrsTyVars, extractHsTyRdrTyVars, extractHsTysRdrTyVars
22 import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs, unknownSigErr )
23 import RnEnv ( bindTyVarsRn, lookupBndrRn, lookupOccRn,
25 bindLocalsRn, bindLocalRn, bindLocalsFVRn, bindUVarRn,
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 ( derivableClassKeys,
44 deRefStablePtr_NAME, makeStablePtr_NAME, bindIO_NAME
46 import Bag ( bagToList )
47 import List ( partition, nub )
49 import SrcLoc ( SrcLoc )
50 import CmdLineOpts ( opt_WarnUnusedMatches ) -- Warn of unused for-all'd tyvars
51 import Unique ( Uniquable(..) )
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 rnHsPolyType 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.
129 In some cases (type signatures of values),
130 it is even necessary to go over the type first
131 in order to get the set of tyvars used by it, make an assoc list,
132 and then go over it again to rename the tyvars!
133 However, we can also do some scoping checks at the same time.
136 rnDecl (TyClD (TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc))
137 = pushSrcLocRn src_loc $
138 lookupBndrRn tycon `thenRn` \ tycon' ->
139 bindTyVarsFVRn data_doc tyvars $ \ tyvars' ->
140 rnContext data_doc context `thenRn` \ (context', cxt_fvs) ->
141 checkDupOrQualNames data_doc con_names `thenRn_`
142 mapFvRn rnConDecl condecls `thenRn` \ (condecls', con_fvs) ->
143 rnDerivs derivings `thenRn` \ (derivings', deriv_fvs) ->
144 ASSERT(isNoDataPragmas pragmas)
145 returnRn (TyClD (TyData new_or_data context' tycon' tyvars' condecls'
146 derivings' noDataPragmas src_loc),
147 cxt_fvs `plusFV` con_fvs `plusFV` deriv_fvs)
149 data_doc = text "the data type declaration for" <+> quotes (ppr tycon)
150 con_names = map conDeclName condecls
152 rnDecl (TyClD (TySynonym name tyvars ty src_loc))
153 = pushSrcLocRn src_loc $
154 lookupBndrRn name `thenRn` \ name' ->
155 bindTyVarsFVRn syn_doc tyvars $ \ tyvars' ->
156 rnHsType syn_doc ty `thenRn` \ (ty', ty_fvs) ->
157 returnRn (TyClD (TySynonym name' tyvars' ty' src_loc), ty_fvs)
159 syn_doc = text "the declaration for type synonym" <+> quotes (ppr name)
161 rnDecl (TyClD (ClassDecl context cname tyvars sigs mbinds pragmas
162 tname dname snames src_loc))
163 = pushSrcLocRn src_loc $
165 lookupBndrRn cname `thenRn` \ cname' ->
167 -- Deal with the implicit tycon and datacon name
168 -- They aren't in scope (because they aren't visible to the user)
169 -- and what we want to do is simply look them up in the cache;
170 -- we jolly well ought to get a 'hit' there!
171 -- So the 'Imported' part of this call is not relevant.
172 -- Unclean; but since these two are the only place this happens
173 -- I can't work up the energy to do it more beautifully
174 mkImportedGlobalFromRdrName tname `thenRn` \ tname' ->
175 mkImportedGlobalFromRdrName dname `thenRn` \ dname' ->
176 mapRn mkImportedGlobalFromRdrName snames `thenRn` \ snames' ->
178 -- Tyvars scope over bindings and context
179 bindTyVarsFV2Rn cls_doc tyvars ( \ clas_tyvar_names tyvars' ->
181 -- Check the superclasses
182 rnContext cls_doc context `thenRn` \ (context', cxt_fvs) ->
184 -- Check the signatures
186 -- First process the class op sigs, then the fixity sigs.
187 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
188 (fix_sigs, non_sigs) = partition isFixitySig non_op_sigs
190 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
191 mapFvRn (rn_op cname' clas_tyvar_names) op_sigs
192 `thenRn` \ (sigs', sig_fvs) ->
193 mapRn_ (unknownSigErr) non_sigs `thenRn_`
195 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _ _) <- sigs' ]
197 renameSigs False binders lookupOccRn fix_sigs
198 `thenRn` \ (fixs', fix_fvs) ->
201 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
203 `thenRn` \ (mbinds', meth_fvs) ->
205 -- Typechecker is responsible for checking that we only
206 -- give default-method bindings for things in this class.
207 -- The renamer *could* check this for class decls, but can't
208 -- for instance decls.
210 ASSERT(isNoClassPragmas pragmas)
211 returnRn (TyClD (ClassDecl context' cname' tyvars' (fixs' ++ sigs') mbinds'
212 NoClassPragmas tname' dname' snames' src_loc),
220 cls_doc = text "the declaration for class" <+> ppr cname
221 sig_doc = text "the signatures for class" <+> ppr cname
222 meth_doc = text "the default-methods for class" <+> ppr cname
224 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ _ locn <- sigs]
225 meth_rdr_names_w_locs = bagToList (collectMonoBinders mbinds)
226 meth_rdr_names = map fst meth_rdr_names_w_locs
228 rn_op clas clas_tyvars sig@(ClassOpSig op dm_rdr_name explicit_dm ty locn)
229 = pushSrcLocRn locn $
230 lookupBndrRn op `thenRn` \ op_name ->
232 -- Check the signature
233 rnHsSigType (quotes (ppr op)) ty `thenRn` \ (new_ty, op_ty_fvs) ->
235 check_in_op_ty clas_tyvar =
236 checkRn (clas_tyvar `elemNameSet` op_ty_fvs)
237 (classTyVarNotInOpTyErr clas_tyvar sig)
239 mapRn_ check_in_op_ty clas_tyvars `thenRn_`
241 -- Make the default-method name
242 getModeRn `thenRn` \ mode ->
244 SourceMode -> -- Source class decl
245 newImplicitBinder (mkDefaultMethodOcc (rdrNameOcc op)) locn `thenRn` \ dm_name ->
246 returnRn (dm_name, op `elem` meth_rdr_names, emptyFVs)
249 -> -- Imported class that has a default method decl
250 -- See comments with tname, snames, above
251 lookupImplicitOccRn dm_rdr_name `thenRn` \ dm_name ->
252 returnRn (dm_name, explicit_dm, if explicit_dm then unitFV dm_name else emptyFVs)
253 -- An imported class decl for a class decl that had an explicit default
254 -- method, mentions, rather than defines,
255 -- the default method, so we must arrange to pull it in
256 ) `thenRn` \ (dm_name, final_explicit_dm, dm_fvs) ->
258 returnRn (ClassOpSig op_name dm_name final_explicit_dm new_ty locn, op_ty_fvs `plusFV` dm_fvs)
262 %*********************************************************
264 \subsection{Instance declarations}
266 %*********************************************************
269 rnDecl (InstD (InstDecl inst_ty mbinds uprags dfun_rdr_name src_loc))
270 = pushSrcLocRn src_loc $
271 rnHsSigType (text "an instance decl") inst_ty `thenRn` \ (inst_ty', inst_fvs) ->
273 inst_tyvars = case inst_ty' of
274 HsForAllTy (Just inst_tyvars) _ _ -> inst_tyvars
276 -- (Slightly strangely) the forall-d tyvars scope over
277 -- the method bindings too
280 -- Rename the bindings
281 -- NB meth_names can be qualified!
282 checkDupNames meth_doc meth_names `thenRn_`
283 extendTyVarEnvFVRn inst_tyvars (
285 ) `thenRn` \ (mbinds', meth_fvs) ->
287 binders = mkNameSet (map fst (bagToList (collectMonoBinders mbinds')))
289 -- Delete sigs (&report) sigs that aren't allowed inside an
295 (ok_sigs, not_ok_idecl_sigs) = partition okInInstDecl uprags
297 okInInstDecl (FixSig _) = False
298 okInInstDecl (Sig _ _ _) = False
299 okInInstDecl _ = True
302 -- You can't have fixity decls & type signatures
303 -- within an instance declaration.
304 mapRn_ unknownSigErr not_ok_idecl_sigs `thenRn_`
306 -- Rename the prags and signatures.
307 -- Note that the type variables are not in scope here,
308 -- so that instance Eq a => Eq (T a) where
309 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
311 renameSigs False binders lookupOccRn ok_sigs `thenRn` \ (new_uprags, prag_fvs) ->
313 getModeRn `thenRn` \ mode ->
315 InterfaceMode -> lookupImplicitOccRn dfun_rdr_name `thenRn` \ dfun_name ->
316 returnRn (dfun_name, unitFV dfun_name)
317 SourceMode -> newDFunName (getDFunKey inst_ty') src_loc
318 `thenRn` \ dfun_name ->
319 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 returnRn (DefD (DefaultDecl tys' src_loc), fvs)
343 doc_str = text "a `default' declaration"
346 %*********************************************************
348 \subsection{Foreign declarations}
350 %*********************************************************
353 rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
354 = pushSrcLocRn src_loc $
355 lookupOccRn name `thenRn` \ name' ->
357 fvs1 = case imp_exp of
358 FoImport _ | not isDyn -> emptyFVs
360 FoExport | isDyn -> mkNameSet [makeStablePtr_NAME,
363 | otherwise -> mkNameSet [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) = rnHsPolyType 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 = mapRn do_one clss `thenRn` \ clss' ->
432 returnRn (Just clss', mkNameSet clss')
434 do_one cls = lookupOccRn cls `thenRn` \ clas_name ->
435 checkRn (getUnique clas_name `elem` derivableClassKeys)
436 (derivingNonStdClassErr clas_name) `thenRn_`
441 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
442 conDeclName (ConDecl n _ _ _ l) = (n,l)
444 rnConDecl :: RdrNameConDecl -> RnMS (RenamedConDecl, FreeVars)
445 rnConDecl (ConDecl name tvs cxt details locn)
446 = pushSrcLocRn locn $
447 checkConName name `thenRn_`
448 lookupBndrRn name `thenRn` \ new_name ->
449 bindTyVarsFVRn doc tvs $ \ new_tyvars ->
450 rnContext doc cxt `thenRn` \ (new_context, cxt_fvs) ->
451 rnConDetails doc locn details `thenRn` \ (new_details, det_fvs) ->
452 returnRn (ConDecl new_name new_tyvars new_context new_details locn,
453 cxt_fvs `plusFV` det_fvs)
455 doc = text "the definition of data constructor" <+> quotes (ppr name)
457 rnConDetails doc locn (VanillaCon tys)
458 = mapFvRn (rnBangTy doc) tys `thenRn` \ (new_tys, fvs) ->
459 returnRn (VanillaCon new_tys, fvs)
461 rnConDetails doc locn (InfixCon ty1 ty2)
462 = rnBangTy doc ty1 `thenRn` \ (new_ty1, fvs1) ->
463 rnBangTy doc ty2 `thenRn` \ (new_ty2, fvs2) ->
464 returnRn (InfixCon new_ty1 new_ty2, fvs1 `plusFV` fvs2)
466 rnConDetails doc locn (NewCon ty mb_field)
467 = rnHsPolyType doc ty `thenRn` \ (new_ty, fvs) ->
468 rn_field mb_field `thenRn` \ new_mb_field ->
469 returnRn (NewCon new_ty new_mb_field, fvs)
471 rn_field Nothing = returnRn Nothing
473 lookupBndrRn f `thenRn` \ new_f ->
474 returnRn (Just new_f)
476 rnConDetails doc locn (RecCon fields)
477 = checkDupOrQualNames doc field_names `thenRn_`
478 mapFvRn (rnField doc) fields `thenRn` \ (new_fields, fvs) ->
479 returnRn (RecCon new_fields, fvs)
481 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
483 rnField doc (names, ty)
484 = mapRn lookupBndrRn names `thenRn` \ new_names ->
485 rnBangTy doc ty `thenRn` \ (new_ty, fvs) ->
486 returnRn ((new_names, new_ty), fvs)
488 rnBangTy doc (Banged ty)
489 = rnHsPolyType doc ty `thenRn` \ (new_ty, fvs) ->
490 returnRn (Banged new_ty, fvs)
492 rnBangTy doc (Unbanged ty)
493 = rnHsPolyType doc ty `thenRn` \ (new_ty, fvs) ->
494 returnRn (Unbanged new_ty, fvs)
496 rnBangTy doc (Unpacked ty)
497 = rnHsPolyType doc ty `thenRn` \ (new_ty, fvs) ->
498 returnRn (Unpacked new_ty, fvs)
500 -- This data decl will parse OK
502 -- treating "a" as the constructor.
503 -- It is really hard to make the parser spot this malformation.
504 -- So the renamer has to check that the constructor is legal
506 -- We can get an operator as the constructor, even in the prefix form:
507 -- data T = :% Int Int
508 -- from interface files, which always print in prefix form
511 = checkRn (isRdrDataCon name)
516 %*********************************************************
518 \subsection{Support code to rename types}
520 %*********************************************************
523 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
524 -- rnHsSigType is used for source-language type signatures,
525 -- which use *implicit* universal quantification.
526 rnHsSigType doc_str ty
527 = rnHsPolyType (text "the type signature for" <+> doc_str) ty
529 ---------------------------------------
530 rnHsPolyType, rnHsType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
531 -- rnHsPolyType is prepared to see a for-all; rnHsType is not
532 -- The former is called for the top level of type sigs and function args.
534 ---------------------------------------
535 rnHsPolyType doc (HsForAllTy Nothing ctxt ty)
536 -- From source code (no kinds on tyvars)
537 -- Given the signature C => T we universally quantify
538 -- over FV(T) \ {in-scope-tyvars}
539 = getLocalNameEnv `thenRn` \ name_env ->
541 mentioned_in_tau = extractHsTyRdrTyVars ty
542 forall_tyvars = filter (not . (`elemFM` name_env)) mentioned_in_tau
544 checkConstraints doc forall_tyvars mentioned_in_tau ctxt ty `thenRn` \ ctxt' ->
545 rnForAll doc (map UserTyVar forall_tyvars) ctxt' ty
547 rnHsPolyType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
548 -- Explicit quantification.
549 -- Check that the forall'd tyvars are a subset of the
550 -- free tyvars in the tau-type part
551 -- That's only a warning... unless the tyvar is constrained by a
552 -- context in which case it's an error
554 mentioned_in_tau = extractHsTyRdrTyVars tau
555 mentioned_in_ctxt = nub [tv | (_,tys) <- ctxt,
557 tv <- extractHsTyRdrTyVars ty]
559 dubious_guys = filter (`notElem` mentioned_in_tau) forall_tyvar_names
560 -- dubious = explicitly quantified but not mentioned in tau type
562 (bad_guys, warn_guys) = partition (`elem` mentioned_in_ctxt) dubious_guys
563 -- bad = explicitly quantified and constrained, but not mentioned in tau
564 -- warn = explicitly quantified but not mentioned in ctxt or tau
566 forall_tyvar_names = map getTyVarName forall_tyvars
568 mapRn_ (forAllErr doc tau) bad_guys `thenRn_`
569 mapRn_ (forAllWarn doc tau) warn_guys `thenRn_`
570 checkConstraints doc forall_tyvar_names mentioned_in_tau ctxt tau `thenRn` \ ctxt' ->
571 rnForAll doc forall_tyvars ctxt' tau
573 rnHsPolyType doc other_ty = rnHsType doc other_ty
576 -- Check that each constraint mentions at least one of the forall'd type variables
577 -- Since the forall'd type variables are a subset of the free tyvars
578 -- of the tau-type part, this guarantees that every constraint mentions
579 -- at least one of the free tyvars in ty
580 checkConstraints doc forall_tyvars tau_vars ctxt ty
581 = mapRn check ctxt `thenRn` \ maybe_ctxt' ->
582 returnRn (catMaybes maybe_ctxt')
583 -- Remove problem ones, to avoid duplicate error message.
586 | ambiguous = failWithRn Nothing (ambigErr doc ct ty)
587 | not_univ = failWithRn Nothing (univErr doc ct ty)
588 | otherwise = returnRn (Just ct)
590 ct_vars = extractHsTysRdrTyVars tys
592 ambiguous = -- All the universally-quantified tyvars in the constraint must appear in the tau ty
593 -- (will change when we get functional dependencies)
594 not (all (\ct_var -> not (ct_var `elem` forall_tyvars) || ct_var `elem` tau_vars) ct_vars)
596 not_univ = -- At least one of the tyvars in each constraint must
597 -- be universally quantified. This restriction isn't in Hugs
598 not (any (`elem` forall_tyvars) ct_vars)
601 rnForAll doc forall_tyvars ctxt ty
602 = bindTyVarsFVRn doc forall_tyvars $ \ new_tyvars ->
603 rnContext doc ctxt `thenRn` \ (new_ctxt, cxt_fvs) ->
604 rnHsType doc ty `thenRn` \ (new_ty, ty_fvs) ->
605 returnRn (mkHsForAllTy (Just new_tyvars) new_ctxt new_ty,
606 cxt_fvs `plusFV` ty_fvs)
608 ---------------------------------------
609 rnHsType doc ty@(HsForAllTy _ _ inner_ty)
610 = addWarnRn (unexpectedForAllTy ty) `thenRn_`
613 rnHsType doc (MonoTyVar tyvar)
614 = lookupOccRn tyvar `thenRn` \ tyvar' ->
615 returnRn (MonoTyVar tyvar', unitFV tyvar')
617 rnHsType doc (MonoFunTy ty1 ty2)
618 = rnHsPolyType doc ty1 `thenRn` \ (ty1', fvs1) ->
619 -- Might find a for-all as the arg of a function type
620 rnHsPolyType doc ty2 `thenRn` \ (ty2', fvs2) ->
621 -- Or as the result. This happens when reading Prelude.hi
622 -- when we find return :: forall m. Monad m -> forall a. a -> m a
623 returnRn (MonoFunTy ty1' ty2', fvs1 `plusFV` fvs2)
625 rnHsType doc (MonoListTy ty)
626 = rnHsType doc ty `thenRn` \ (ty', fvs) ->
627 returnRn (MonoListTy ty', fvs `addOneFV` listTyCon_name)
629 -- Unboxed tuples are allowed to have poly-typed arguments. These
630 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
631 rnHsType doc (MonoTupleTy tys boxed)
633 then mapFvRn (rnHsType doc) tys
634 else mapFvRn (rnHsPolyType doc) tys) `thenRn` \ (tys', fvs) ->
635 returnRn (MonoTupleTy tys' boxed, fvs `addOneFV` tup_con_name)
637 tup_con_name = tupleTyCon_name boxed (length tys)
639 rnHsType doc (MonoTyApp ty1 ty2)
640 = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
641 rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
642 returnRn (MonoTyApp ty1' ty2', fvs1 `plusFV` fvs2)
644 rnHsType doc (MonoDictTy clas tys)
645 = lookupOccRn clas `thenRn` \ clas' ->
646 rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
647 returnRn (MonoDictTy clas' tys', fvs `addOneFV` clas')
649 rnHsType doc (MonoUsgForAllTy uv_rdr ty)
650 = bindUVarRn doc uv_rdr $ \ uv_name ->
651 rnHsType doc ty `thenRn` \ (ty', fvs) ->
652 returnRn (MonoUsgForAllTy uv_name ty',
655 rnHsType doc (MonoUsgTy usg ty)
656 = newUsg usg `thenRn` \ (usg', usg_fvs) ->
657 rnHsPolyType doc ty `thenRn` \ (ty', ty_fvs) ->
658 -- A for-all can occur inside a usage annotation
659 returnRn (MonoUsgTy usg' ty',
660 usg_fvs `plusFV` ty_fvs)
662 newUsg usg = case usg of
663 MonoUsOnce -> returnRn (MonoUsOnce, emptyFVs)
664 MonoUsMany -> returnRn (MonoUsMany, emptyFVs)
665 MonoUsVar uv_rdr -> lookupOccRn uv_rdr `thenRn` \ uv_name ->
666 returnRn (MonoUsVar uv_name, emptyFVs)
668 rnHsTypes doc tys = mapFvRn (rnHsType doc) tys
673 rnContext :: SDoc -> RdrNameContext -> RnMS (RenamedContext, FreeVars)
676 = mapAndUnzipRn rn_ctxt ctxt `thenRn` \ (theta, fvs_s) ->
678 (_, dup_asserts) = removeDups cmp_assert theta
680 -- Check for duplicate assertions
681 -- If this isn't an error, then it ought to be:
682 mapRn_ (addWarnRn . dupClassAssertWarn theta) dup_asserts `thenRn_`
684 returnRn (theta, plusFVs fvs_s)
687 = lookupOccRn clas `thenRn` \ clas_name ->
688 rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
689 returnRn ((clas_name, tys'), fvs `addOneFV` clas_name)
691 cmp_assert (c1,tys1) (c2,tys2)
692 = (c1 `compare` c2) `thenCmp` (cmpHsTypes compare tys1 tys2)
696 %*********************************************************
700 %*********************************************************
703 rnIdInfo (HsStrictness str) = returnRn (HsStrictness str, emptyFVs)
705 rnIdInfo (HsWorker worker)
706 = lookupOccRn worker `thenRn` \ worker' ->
707 returnRn (HsWorker worker', unitFV worker')
709 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ (expr', fvs) ->
710 returnRn (HsUnfold inline expr', fvs)
711 rnIdInfo (HsArity arity) = returnRn (HsArity arity, emptyFVs)
712 rnIdInfo (HsUpdate update) = returnRn (HsUpdate update, emptyFVs)
713 rnIdInfo (HsNoCafRefs) = returnRn (HsNoCafRefs, emptyFVs)
714 rnIdInfo (HsCprInfo cpr_info) = returnRn (HsCprInfo cpr_info, emptyFVs)
715 rnIdInfo (HsSpecialise rule_body) = rnRuleBody rule_body
716 `thenRn` \ (rule_body', fvs) ->
717 returnRn (HsSpecialise rule_body', fvs)
719 rnRuleBody (UfRuleBody str vars args rhs)
720 = rnCoreBndrs vars $ \ vars' ->
721 mapFvRn rnCoreExpr args `thenRn` \ (args', fvs1) ->
722 rnCoreExpr rhs `thenRn` \ (rhs', fvs2) ->
723 returnRn (UfRuleBody str vars' args' rhs', fvs1 `plusFV` fvs2)
726 @UfCore@ expressions.
729 rnCoreExpr (UfType ty)
730 = rnHsPolyType (text "unfolding type") ty `thenRn` \ (ty', fvs) ->
731 returnRn (UfType ty', fvs)
734 = lookupOccRn v `thenRn` \ v' ->
735 returnRn (UfVar v', unitFV v')
737 rnCoreExpr (UfCon con args)
738 = rnUfCon con `thenRn` \ (con', fvs1) ->
739 mapFvRn rnCoreExpr args `thenRn` \ (args', fvs2) ->
740 returnRn (UfCon con' args', fvs1 `plusFV` fvs2)
742 rnCoreExpr (UfTuple con args)
743 = lookupOccRn con `thenRn` \ con' ->
744 mapFvRn rnCoreExpr args `thenRn` \ (args', fvs) ->
745 returnRn (UfTuple con' args', fvs `addOneFV` con')
747 rnCoreExpr (UfApp fun arg)
748 = rnCoreExpr fun `thenRn` \ (fun', fv1) ->
749 rnCoreExpr arg `thenRn` \ (arg', fv2) ->
750 returnRn (UfApp fun' arg', fv1 `plusFV` fv2)
752 rnCoreExpr (UfCase scrut bndr alts)
753 = rnCoreExpr scrut `thenRn` \ (scrut', fvs1) ->
754 bindCoreLocalFVRn bndr ( \ bndr' ->
755 mapFvRn rnCoreAlt alts `thenRn` \ (alts', fvs2) ->
756 returnRn (UfCase scrut' bndr' alts', fvs2)
757 ) `thenRn` \ (case', fvs3) ->
758 returnRn (case', fvs1 `plusFV` fvs3)
760 rnCoreExpr (UfNote note expr)
761 = rnNote note `thenRn` \ (note', fvs1) ->
762 rnCoreExpr expr `thenRn` \ (expr', fvs2) ->
763 returnRn (UfNote note' expr', fvs1 `plusFV` fvs2)
765 rnCoreExpr (UfLam bndr body)
766 = rnCoreBndr bndr $ \ bndr' ->
767 rnCoreExpr body `thenRn` \ (body', fvs) ->
768 returnRn (UfLam bndr' body', fvs)
770 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
771 = rnCoreExpr rhs `thenRn` \ (rhs', fvs1) ->
772 rnCoreBndr bndr ( \ bndr' ->
773 rnCoreExpr body `thenRn` \ (body', fvs2) ->
774 returnRn (UfLet (UfNonRec bndr' rhs') body', fvs2)
775 ) `thenRn` \ (result, fvs3) ->
776 returnRn (result, fvs1 `plusFV` fvs3)
778 rnCoreExpr (UfLet (UfRec pairs) body)
779 = rnCoreBndrs bndrs $ \ bndrs' ->
780 mapFvRn rnCoreExpr rhss `thenRn` \ (rhss', fvs1) ->
781 rnCoreExpr body `thenRn` \ (body', fvs2) ->
782 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body', fvs1 `plusFV` fvs2)
784 (bndrs, rhss) = unzip pairs
788 rnCoreBndr (UfValBinder name ty) thing_inside
789 = rnHsPolyType doc ty `thenRn` \ (ty', fvs1) ->
790 bindCoreLocalFVRn name ( \ name' ->
791 thing_inside (UfValBinder name' ty')
792 ) `thenRn` \ (result, fvs2) ->
793 returnRn (result, fvs1 `plusFV` fvs2)
795 doc = text "unfolding id"
797 rnCoreBndr (UfTyBinder name kind) thing_inside
798 = bindCoreLocalFVRn name $ \ name' ->
799 thing_inside (UfTyBinder name' kind)
801 rnCoreBndrs [] thing_inside = thing_inside []
802 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
803 rnCoreBndrs bs $ \ names' ->
804 thing_inside (name':names')
808 rnCoreAlt (con, bndrs, rhs)
809 = rnUfCon con `thenRn` \ (con', fvs1) ->
810 bindCoreLocalsFVRn bndrs ( \ bndrs' ->
811 rnCoreExpr rhs `thenRn` \ (rhs', fvs2) ->
812 returnRn ((con', bndrs', rhs'), fvs2)
813 ) `thenRn` \ (result, fvs3) ->
814 returnRn (result, fvs1 `plusFV` fvs3)
817 = rnHsPolyType (text "unfolding coerce") ty `thenRn` \ (ty', fvs) ->
818 returnRn (UfCoerce ty', fvs)
820 rnNote (UfSCC cc) = returnRn (UfSCC cc, emptyFVs)
821 rnNote UfInlineCall = returnRn (UfInlineCall, emptyFVs)
822 rnNote UfInlineMe = returnRn (UfInlineMe, emptyFVs)
826 = returnRn (UfDefault, emptyFVs)
828 rnUfCon (UfDataCon con)
829 = lookupOccRn con `thenRn` \ con' ->
830 returnRn (UfDataCon con', unitFV con')
832 rnUfCon (UfLitCon lit)
833 = returnRn (UfLitCon lit, emptyFVs)
835 rnUfCon (UfLitLitCon lit ty)
836 = rnHsPolyType (text "litlit") ty `thenRn` \ (ty', fvs) ->
837 returnRn (UfLitLitCon lit ty', fvs)
839 rnUfCon (UfPrimOp op)
840 = lookupOccRn op `thenRn` \ op' ->
841 returnRn (UfPrimOp op', emptyFVs)
843 rnUfCon (UfCCallOp str is_dyn casm gc)
844 = returnRn (UfCCallOp str is_dyn casm gc, emptyFVs)
847 %*********************************************************
849 \subsection{Rule shapes}
851 %*********************************************************
853 Check the shape of a transformation rule LHS. Currently
854 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
855 not one of the @forall@'d variables.
858 validRuleLhs foralls lhs
861 check (HsApp e1 e2) = check e1
862 check (HsVar v) | v `notElem` foralls = True
867 %*********************************************************
871 %*********************************************************
874 derivingNonStdClassErr clas
875 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
877 classTyVarNotInOpTyErr clas_tyvar sig
878 = hang (hsep [ptext SLIT("Class type variable"),
879 quotes (ppr clas_tyvar),
880 ptext SLIT("does not appear in method signature")])
883 dupClassAssertWarn ctxt (assertion : dups)
884 = sep [hsep [ptext SLIT("Duplicate class assertion"),
885 quotes (pprClassAssertion assertion),
886 ptext SLIT("in the context:")],
887 nest 4 (pprContext ctxt <+> ptext SLIT("..."))]
890 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
892 forAllWarn doc ty tyvar
893 | not opt_WarnUnusedMatches = returnRn ()
895 = getModeRn `thenRn` \ mode ->
898 InterfaceMode -> returnRn () ; -- Don't warn of unused tyvars in interface files
899 -- unless DEBUG is on, in which case it is slightly
900 -- informative. They can arise from mkRhsTyLam,
901 #endif -- leading to (say) f :: forall a b. [b] -> [b]
905 sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
906 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
908 (ptext SLIT("In") <+> doc))
911 forAllErr doc ty tyvar
913 sep [ptext SLIT("The constrained type variable") <+> quotes (ppr tyvar),
914 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
916 (ptext SLIT("In") <+> doc))
918 univErr doc constraint ty
919 = sep [ptext SLIT("All of the type variable(s) in the constraint")
920 <+> quotes (pprClassAssertion constraint)
921 <+> ptext SLIT("are already in scope"),
922 nest 4 (ptext SLIT("At least one must be universally quantified here"))
925 (ptext SLIT("In") <+> doc)
927 ambigErr doc constraint ty
928 = sep [ptext SLIT("Ambiguous constraint") <+> quotes (pprClassAssertion constraint),
929 nest 4 (ptext SLIT("in the type:") <+> ppr ty),
930 nest 4 (ptext SLIT("Each forall-d type variable mentioned by the constraint must appear after the =>."))]
932 (ptext SLIT("In") <+> doc)
934 unexpectedForAllTy ty
935 = ptext SLIT("Unexpected forall type:") <+> ppr ty
937 badRuleLhsErr name lhs
938 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
939 nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
941 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
944 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
945 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
946 ptext SLIT("does not appear on left hand side")]