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 ( hsTyVarNames, pprHsContext )
15 import RdrName ( RdrName, isRdrDataCon, rdrNameOcc, isRdrTyVar, mkRdrNameWkr )
16 import RdrHsSyn ( RdrNameContext, RdrNameHsType, RdrNameConDecl,
17 extractRuleBndrsTyVars, extractHsTyRdrTyVars,
18 extractHsTysRdrTyVars, extractHsCtxtRdrTyVars
23 import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs, unknownSigErr )
24 import RnEnv ( bindTyVarsRn, lookupTopBndrRn, lookupOccRn, newIPName,
25 lookupOrigName, lookupOrigNames, lookupSysBinder,
26 bindLocalsRn, bindLocalRn, bindLocalsFVRn, bindUVarRn,
27 bindTyVarsFVRn, bindTyVarsFV2Rn, extendTyVarEnvFVRn,
28 bindCoreLocalFVRn, bindCoreLocalsFVRn, bindLocalNames,
29 checkDupOrQualNames, checkDupNames,
30 FreeVars, emptyFVs, plusFV, plusFVs, unitFV,
35 import FunDeps ( oclose )
36 import Class ( FunDep )
38 import Name ( Name, OccName,
39 ExportFlag(..), Provenance(..),
40 nameOccName, NamedThing(..)
43 import FiniteMap ( elemFM )
44 import PrelInfo ( derivableClassKeys, cCallishClassKeys,
45 deRefStablePtr_RDR, makeStablePtr_RDR,
46 bindIO_RDR, returnIO_RDR
48 import Bag ( bagToList )
49 import List ( partition, nub )
51 import SrcLoc ( SrcLoc )
52 import CmdLineOpts ( opt_GlasgowExts, opt_WarnUnusedMatches ) -- Warn of unused for-all'd tyvars
53 import Unique ( Uniquable(..) )
54 import ErrUtils ( Message )
55 import CStrings ( isCLabelString )
59 @rnDecl@ `renames' declarations.
60 It simultaneously performs dependency analysis and precedence parsing.
61 It also does the following error checks:
64 Checks that tyvars are used properly. This includes checking
65 for undefined tyvars, and tyvars in contexts that are ambiguous.
66 (Some of this checking has now been moved to module @TcMonoType@,
67 since we don't have functional dependency information at this point.)
69 Checks that all variable occurences are defined.
71 Checks the @(..)@ etc constraints in the export list.
75 %*********************************************************
77 \subsection{Value declarations}
79 %*********************************************************
82 rnSourceDecls :: [RdrNameHsDecl] -> RnMS ([RenamedHsDecl], FreeVars)
83 -- The decls get reversed, but that's ok
86 = go emptyFVs [] decls
88 -- Fixity and deprecations have been dealt with already; ignore them
89 go fvs ds' [] = returnRn (ds', fvs)
90 go fvs ds' (FixD _:ds) = go fvs ds' ds
91 go fvs ds' (DeprecD _:ds) = go fvs ds' ds
92 go fvs ds' (d:ds) = rnDecl d `thenRn` \(d', fvs') ->
93 go (fvs `plusFV` fvs') (d':ds') ds
97 %*********************************************************
99 \subsection{Value declarations}
101 %*********************************************************
104 -- rnDecl does all the work
105 rnDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
107 rnDecl (ValD binds) = rnTopBinds binds `thenRn` \ (new_binds, fvs) ->
108 returnRn (ValD new_binds, fvs)
111 rnDecl (SigD (IfaceSig name ty id_infos loc))
113 lookupTopBndrRn name `thenRn` \ name' ->
114 rnHsType doc_str ty `thenRn` \ (ty',fvs1) ->
115 mapFvRn rnIdInfo id_infos `thenRn` \ (id_infos', fvs2) ->
116 returnRn (SigD (IfaceSig name' ty' id_infos' loc), fvs1 `plusFV` fvs2)
118 doc_str = text "the interface signature for" <+> quotes (ppr name)
121 %*********************************************************
123 \subsection{Type declarations}
125 %*********************************************************
127 @rnTyDecl@ uses the `global name function' to create a new type
128 declaration in which local names have been replaced by their original
129 names, reporting any unknown names.
131 Renaming type variables is a pain. Because they now contain uniques,
132 it is necessary to pass in an association list which maps a parsed
133 tyvar to its @Name@ representation.
134 In some cases (type signatures of values),
135 it is even necessary to go over the type first
136 in order to get the set of tyvars used by it, make an assoc list,
137 and then go over it again to rename the tyvars!
138 However, we can also do some scoping checks at the same time.
141 rnDecl (TyClD (TyData new_or_data context tycon tyvars condecls nconstrs derivings pragmas src_loc))
142 = pushSrcLocRn src_loc $
143 lookupTopBndrRn tycon `thenRn` \ tycon' ->
144 bindTyVarsFVRn data_doc tyvars $ \ tyvars' ->
145 rnContext data_doc context `thenRn` \ (context', cxt_fvs) ->
146 checkDupOrQualNames data_doc con_names `thenRn_`
147 mapFvRn rnConDecl condecls `thenRn` \ (condecls', con_fvs) ->
148 rnDerivs derivings `thenRn` \ (derivings', deriv_fvs) ->
149 ASSERT(isNoDataPragmas pragmas)
150 returnRn (TyClD (TyData new_or_data context' tycon' tyvars' condecls' nconstrs
151 derivings' noDataPragmas src_loc),
152 cxt_fvs `plusFV` con_fvs `plusFV` deriv_fvs)
154 data_doc = text "the data type declaration for" <+> quotes (ppr tycon)
155 con_names = map conDeclName condecls
157 rnDecl (TyClD (TySynonym name tyvars ty src_loc))
158 = pushSrcLocRn src_loc $
159 lookupTopBndrRn name `thenRn` \ name' ->
160 bindTyVarsFVRn syn_doc tyvars $ \ tyvars' ->
161 rnHsType syn_doc (unquantify ty) `thenRn` \ (ty', ty_fvs) ->
162 returnRn (TyClD (TySynonym name' tyvars' ty' src_loc), ty_fvs)
164 syn_doc = text "the declaration for type synonym" <+> quotes (ppr name)
166 -- For H98 we do *not* universally quantify on the RHS of a synonym
167 -- Silently discard context... but the tyvars in the rest won't be in scope
168 unquantify (HsForAllTy Nothing ctxt ty) | not opt_GlasgowExts = ty
171 rnDecl (TyClD (ClassDecl context cname tyvars fds sigs mbinds pragmas
172 tname dname dwname snames src_loc))
173 = pushSrcLocRn src_loc $
175 lookupTopBndrRn cname `thenRn` \ cname' ->
177 -- Deal with the implicit tycon and datacon name
178 -- They aren't in scope (because they aren't visible to the user)
179 -- and what we want to do is simply look them up in the cache;
180 -- we jolly well ought to get a 'hit' there!
181 -- So the 'Imported' part of this call is not relevant.
182 -- Unclean; but since these two are the only place this happens
183 -- I can't work up the energy to do it more beautifully
184 lookupSysBinder tname `thenRn` \ tname' ->
185 lookupSysBinder dname `thenRn` \ dname' ->
186 lookupSysBinder dwname `thenRn` \ dwname' ->
187 mapRn lookupSysBinder snames `thenRn` \ snames' ->
189 -- Tyvars scope over bindings and context
190 bindTyVarsFV2Rn cls_doc tyvars ( \ clas_tyvar_names tyvars' ->
192 -- Check the superclasses
193 rnContext cls_doc context `thenRn` \ (context', cxt_fvs) ->
195 -- Check the functional dependencies
196 rnFds cls_doc fds `thenRn` \ (fds', fds_fvs) ->
198 -- Check the signatures
200 -- First process the class op sigs, then the fixity sigs.
201 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
203 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
204 mapFvRn (rn_op cname' clas_tyvar_names fds') op_sigs `thenRn` \ (sigs', sig_fvs) ->
206 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
208 renameSigs (okClsDclSig binders) non_op_sigs `thenRn` \ (non_ops', fix_fvs) ->
211 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
212 rnMethodBinds mbinds `thenRn` \ (mbinds', meth_fvs) ->
214 -- Typechecker is responsible for checking that we only
215 -- give default-method bindings for things in this class.
216 -- The renamer *could* check this for class decls, but can't
217 -- for instance decls.
219 ASSERT(isNoClassPragmas pragmas)
220 returnRn (TyClD (ClassDecl context' cname' tyvars' fds' (non_ops' ++ sigs') mbinds'
221 NoClassPragmas tname' dname' dwname' snames' src_loc),
230 cls_doc = text "the declaration for class" <+> ppr cname
231 sig_doc = text "the signatures for class" <+> ppr cname
232 meth_doc = text "the default-methods for class" <+> ppr cname
234 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
235 meth_rdr_names_w_locs = bagToList (collectMonoBinders mbinds)
237 rn_op clas clas_tyvars clas_fds sig@(ClassOpSig op maybe_dm_stuff ty locn)
238 = pushSrcLocRn locn $
239 lookupTopBndrRn op `thenRn` \ op_name ->
241 -- Check the signature
242 rnHsSigType (quotes (ppr op)) ty `thenRn` \ (new_ty, op_ty_fvs) ->
244 check_in_op_ty clas_tyvar =
245 checkRn (clas_tyvar `elemNameSet` oclose clas_fds op_ty_fvs)
246 (classTyVarNotInOpTyErr clas_tyvar sig)
248 mapRn_ check_in_op_ty clas_tyvars `thenRn_`
250 -- Make the default-method name
251 (case maybe_dm_stuff of
252 Nothing -> returnRn (Nothing, emptyFVs) -- Source-file class decl
254 Just (dm_rdr_name, explicit_dm)
255 -> -- Imported class that has a default method decl
256 -- See comments with tname, snames, above
257 lookupSysBinder dm_rdr_name `thenRn` \ dm_name ->
258 returnRn (Just (dm_name, explicit_dm),
259 if explicit_dm then unitFV dm_name else emptyFVs)
260 -- An imported class decl for a class decl that had an explicit default
261 -- method, mentions, rather than defines,
262 -- the default method, so we must arrange to pull it in
263 ) `thenRn` \ (maybe_dm_stuff', dm_fvs) ->
265 returnRn (ClassOpSig op_name maybe_dm_stuff' new_ty locn, op_ty_fvs `plusFV` dm_fvs)
269 %*********************************************************
271 \subsection{Instance declarations}
273 %*********************************************************
276 rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc))
277 = pushSrcLocRn src_loc $
278 rnHsSigType (text "an instance decl") inst_ty `thenRn` \ (inst_ty', inst_fvs) ->
280 inst_tyvars = case inst_ty' of
281 HsForAllTy (Just inst_tyvars) _ _ -> inst_tyvars
283 -- (Slightly strangely) the forall-d tyvars scope over
284 -- the method bindings too
287 -- Rename the bindings
288 -- NB meth_names can be qualified!
289 checkDupNames meth_doc meth_names `thenRn_`
290 extendTyVarEnvFVRn inst_tyvars (
292 ) `thenRn` \ (mbinds', meth_fvs) ->
294 binders = map fst (bagToList (collectMonoBinders mbinds'))
295 binder_set = mkNameSet binders
297 -- Rename the prags and signatures.
298 -- Note that the type variables are not in scope here,
299 -- so that instance Eq a => Eq (T a) where
300 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
303 -- But the (unqualified) method names are in scope
304 bindLocalNames binders (
305 renameSigs (okInstDclSig binder_set) uprags
306 ) `thenRn` \ (new_uprags, prag_fvs) ->
308 (case maybe_dfun_rdr_name of
309 Nothing -> returnRn (Nothing, emptyFVs)
311 Just dfun_rdr_name -> lookupSysBinder dfun_rdr_name `thenRn` \ dfun_name ->
312 returnRn (Just dfun_name, unitFV dfun_name)
313 ) `thenRn` \ (maybe_dfun_name, dfun_fv) ->
315 -- The typechecker checks that all the bindings are for the right class.
316 returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags maybe_dfun_name src_loc),
317 inst_fvs `plusFV` meth_fvs `plusFV` prag_fvs `plusFV` dfun_fv)
319 meth_doc = text "the bindings in an instance declaration"
320 meth_names = bagToList (collectMonoBinders mbinds)
323 %*********************************************************
325 \subsection{Default declarations}
327 %*********************************************************
330 rnDecl (DefD (DefaultDecl tys src_loc))
331 = pushSrcLocRn src_loc $
332 rnHsTypes doc_str tys `thenRn` \ (tys', fvs) ->
333 returnRn (DefD (DefaultDecl tys' src_loc), fvs)
335 doc_str = text "a `default' declaration"
338 %*********************************************************
340 \subsection{Foreign declarations}
342 %*********************************************************
345 rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
346 = pushSrcLocRn src_loc $
347 lookupOccRn name `thenRn` \ name' ->
350 | isDyn = lookupOrigNames [makeStablePtr_RDR, deRefStablePtr_RDR,
351 bindIO_RDR, returnIO_RDR]
353 lookupOrigNames [bindIO_RDR, returnIO_RDR] `thenRn` \ fvs ->
354 returnRn (addOneFV fvs name')
355 extra_fvs other = returnRn emptyFVs
357 checkRn (ok_ext_nm ext_nm) (badExtName ext_nm) `thenRn_`
359 extra_fvs imp_exp `thenRn` \ fvs1 ->
361 rnHsSigType fo_decl_msg ty `thenRn` \ (ty', fvs2) ->
362 returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc),
365 fo_decl_msg = ptext SLIT("a foreign declaration")
366 isDyn = isDynamicExtName ext_nm
368 ok_ext_nm Dynamic = True
369 ok_ext_nm (ExtName nm (Just mb)) = isCLabelString nm && isCLabelString mb
370 ok_ext_nm (ExtName nm Nothing) = isCLabelString nm
373 %*********************************************************
377 %*********************************************************
380 rnDecl (RuleD (IfaceRule rule_name vars fn args rhs src_loc))
381 = pushSrcLocRn src_loc $
382 lookupOccRn fn `thenRn` \ fn' ->
383 rnCoreBndrs vars $ \ vars' ->
384 mapFvRn rnCoreExpr args `thenRn` \ (args', fvs1) ->
385 rnCoreExpr rhs `thenRn` \ (rhs', fvs2) ->
386 returnRn (RuleD (IfaceRule rule_name vars' fn' args' rhs' src_loc),
387 (fvs1 `plusFV` fvs2) `addOneFV` fn')
389 rnDecl (RuleD (IfaceRuleOut fn rule))
390 -- This one is used for BuiltInRules
391 -- The rule itself is already done, but the thing
392 -- to attach it to is not.
393 = lookupOccRn fn `thenRn` \ fn' ->
394 returnRn (RuleD (IfaceRuleOut fn' rule), unitFV fn')
396 rnDecl (RuleD (HsRule rule_name tvs vars lhs rhs src_loc))
398 pushSrcLocRn src_loc $
400 bindTyVarsFV2Rn doc (map UserTyVar sig_tvs) $ \ sig_tvs' _ ->
401 bindLocalsFVRn doc (map get_var vars) $ \ ids ->
402 mapFvRn rn_var (vars `zip` ids) `thenRn` \ (vars', fv_vars) ->
404 rnExpr lhs `thenRn` \ (lhs', fv_lhs) ->
405 rnExpr rhs `thenRn` \ (rhs', fv_rhs) ->
406 checkRn (validRuleLhs ids lhs')
407 (badRuleLhsErr rule_name lhs') `thenRn_`
409 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
411 mapRn (addErrRn . badRuleVar rule_name) bad_vars `thenRn_`
412 returnRn (RuleD (HsRule rule_name sig_tvs' vars' lhs' rhs' src_loc),
413 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
415 doc = text "the transformation rule" <+> ptext rule_name
416 sig_tvs = extractRuleBndrsTyVars vars
418 get_var (RuleBndr v) = v
419 get_var (RuleBndrSig v _) = v
421 rn_var (RuleBndr v, id) = returnRn (RuleBndr id, emptyFVs)
422 rn_var (RuleBndrSig v t, id) = rnHsType doc t `thenRn` \ (t', fvs) ->
423 returnRn (RuleBndrSig id t', fvs)
427 %*********************************************************
429 \subsection{Support code for type/data declarations}
431 %*********************************************************
434 rnDerivs :: Maybe [RdrName] -> RnMS (Maybe [Name], FreeVars)
436 rnDerivs Nothing -- derivs not specified
437 = returnRn (Nothing, emptyFVs)
440 = mapRn do_one clss `thenRn` \ clss' ->
441 returnRn (Just clss', mkNameSet clss')
443 do_one cls = lookupOccRn cls `thenRn` \ clas_name ->
444 checkRn (getUnique clas_name `elem` derivableClassKeys)
445 (derivingNonStdClassErr clas_name) `thenRn_`
450 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
451 conDeclName (ConDecl n _ _ _ _ l) = (n,l)
453 rnConDecl :: RdrNameConDecl -> RnMS (RenamedConDecl, FreeVars)
454 rnConDecl (ConDecl name wkr tvs cxt details locn)
455 = pushSrcLocRn locn $
456 checkConName name `thenRn_`
457 lookupTopBndrRn name `thenRn` \ new_name ->
459 lookupSysBinder wkr `thenRn` \ new_wkr ->
460 -- See comments with ClassDecl
462 bindTyVarsFVRn doc tvs $ \ new_tyvars ->
463 rnContext doc cxt `thenRn` \ (new_context, cxt_fvs) ->
464 rnConDetails doc locn details `thenRn` \ (new_details, det_fvs) ->
465 returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn,
466 cxt_fvs `plusFV` det_fvs)
468 doc = text "the definition of data constructor" <+> quotes (ppr name)
470 rnConDetails doc locn (VanillaCon tys)
471 = mapFvRn (rnBangTy doc) tys `thenRn` \ (new_tys, fvs) ->
472 returnRn (VanillaCon new_tys, fvs)
474 rnConDetails doc locn (InfixCon ty1 ty2)
475 = rnBangTy doc ty1 `thenRn` \ (new_ty1, fvs1) ->
476 rnBangTy doc ty2 `thenRn` \ (new_ty2, fvs2) ->
477 returnRn (InfixCon new_ty1 new_ty2, fvs1 `plusFV` fvs2)
479 rnConDetails doc locn (NewCon ty mb_field)
480 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
481 rn_field mb_field `thenRn` \ new_mb_field ->
482 returnRn (NewCon new_ty new_mb_field, fvs)
484 rn_field Nothing = returnRn Nothing
486 lookupTopBndrRn f `thenRn` \ new_f ->
487 returnRn (Just new_f)
489 rnConDetails doc locn (RecCon fields)
490 = checkDupOrQualNames doc field_names `thenRn_`
491 mapFvRn (rnField doc) fields `thenRn` \ (new_fields, fvs) ->
492 returnRn (RecCon new_fields, fvs)
494 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
496 rnField doc (names, ty)
497 = mapRn lookupTopBndrRn names `thenRn` \ new_names ->
498 rnBangTy doc ty `thenRn` \ (new_ty, fvs) ->
499 returnRn ((new_names, new_ty), fvs)
501 rnBangTy doc (Banged ty)
502 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
503 returnRn (Banged new_ty, fvs)
505 rnBangTy doc (Unbanged ty)
506 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
507 returnRn (Unbanged new_ty, fvs)
509 rnBangTy doc (Unpacked ty)
510 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
511 returnRn (Unpacked new_ty, fvs)
513 -- This data decl will parse OK
515 -- treating "a" as the constructor.
516 -- It is really hard to make the parser spot this malformation.
517 -- So the renamer has to check that the constructor is legal
519 -- We can get an operator as the constructor, even in the prefix form:
520 -- data T = :% Int Int
521 -- from interface files, which always print in prefix form
524 = checkRn (isRdrDataCon name)
529 %*********************************************************
531 \subsection{Support code to rename types}
533 %*********************************************************
536 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
537 -- rnHsSigType is used for source-language type signatures,
538 -- which use *implicit* universal quantification.
539 rnHsSigType doc_str ty
540 = rnHsType (text "the type signature for" <+> doc_str) ty
542 ---------------------------------------
543 rnHsType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
545 rnHsType doc (HsForAllTy Nothing ctxt ty)
546 -- Implicit quantifiction in source code (no kinds on tyvars)
547 -- Given the signature C => T we universally quantify
548 -- over FV(T) \ {in-scope-tyvars}
549 = getLocalNameEnv `thenRn` \ name_env ->
551 mentioned_in_tau = extractHsTyRdrTyVars ty
552 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
553 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
554 forall_tyvars = filter (not . (`elemFM` name_env)) mentioned
556 rnForAll doc (map UserTyVar forall_tyvars) ctxt ty
558 rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
559 -- Explicit quantification.
560 -- Check that the forall'd tyvars are actually
561 -- mentioned in the type, and produce a warning if not
563 mentioned_in_tau = extractHsTyRdrTyVars tau
564 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
565 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
566 forall_tyvar_names = hsTyVarNames forall_tyvars
568 -- Explicitly quantified but not mentioned in ctxt or tau
569 warn_guys = filter (`notElem` mentioned) forall_tyvar_names
571 mapRn_ (forAllWarn doc tau) warn_guys `thenRn_`
572 rnForAll doc forall_tyvars ctxt tau
574 rnHsType doc (HsTyVar tyvar)
575 = lookupOccRn tyvar `thenRn` \ tyvar' ->
576 returnRn (HsTyVar tyvar', unitFV tyvar')
578 rnHsType doc (HsFunTy ty1 ty2)
579 = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
580 -- Might find a for-all as the arg of a function type
581 rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
582 -- Or as the result. This happens when reading Prelude.hi
583 -- when we find return :: forall m. Monad m -> forall a. a -> m a
584 returnRn (HsFunTy ty1' ty2', fvs1 `plusFV` fvs2)
586 rnHsType doc (HsListTy ty)
587 = rnHsType doc ty `thenRn` \ (ty', fvs) ->
588 returnRn (HsListTy ty', fvs `addOneFV` listTyCon_name)
590 -- Unboxed tuples are allowed to have poly-typed arguments. These
591 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
592 rnHsType doc (HsTupleTy (HsTupCon _ boxity) tys)
593 -- Don't do lookupOccRn, because this is built-in syntax
594 -- so it doesn't need to be in scope
595 = mapFvRn (rnHsType doc) tys `thenRn` \ (tys', fvs) ->
596 returnRn (HsTupleTy (HsTupCon n' boxity) tys', fvs `addOneFV` n')
598 n' = tupleTyCon_name boxity (length tys)
601 rnHsType doc (HsAppTy ty1 ty2)
602 = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
603 rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
604 returnRn (HsAppTy ty1' ty2', fvs1 `plusFV` fvs2)
606 rnHsType doc (HsPredTy pred)
607 = rnPred doc pred `thenRn` \ (pred', fvs) ->
608 returnRn (HsPredTy pred', fvs)
610 rnHsType doc (HsUsgForAllTy uv_rdr ty)
611 = bindUVarRn doc uv_rdr $ \ uv_name ->
612 rnHsType doc ty `thenRn` \ (ty', fvs) ->
613 returnRn (HsUsgForAllTy uv_name ty',
616 rnHsType doc (HsUsgTy usg ty)
617 = newUsg usg `thenRn` \ (usg', usg_fvs) ->
618 rnHsType doc ty `thenRn` \ (ty', ty_fvs) ->
619 -- A for-all can occur inside a usage annotation
620 returnRn (HsUsgTy usg' ty',
621 usg_fvs `plusFV` ty_fvs)
623 newUsg usg = case usg of
624 HsUsOnce -> returnRn (HsUsOnce, emptyFVs)
625 HsUsMany -> returnRn (HsUsMany, emptyFVs)
626 HsUsVar uv_rdr -> lookupOccRn uv_rdr `thenRn` \ uv_name ->
627 returnRn (HsUsVar uv_name, emptyFVs)
629 rnHsTypes doc tys = mapFvRn (rnHsType doc) tys
633 -- We use lookupOcc here because this is interface file only stuff
634 -- and we need the workers...
635 rnHsTupCon (HsTupCon n boxity)
636 = lookupOccRn n `thenRn` \ n' ->
637 returnRn (HsTupCon n' boxity, unitFV n')
639 rnHsTupConWkr (HsTupCon n boxity)
640 -- Tuple construtors are for the *worker* of the tuple
641 -- Going direct saves needless messing about
642 = lookupOccRn (mkRdrNameWkr n) `thenRn` \ n' ->
643 returnRn (HsTupCon n' boxity, unitFV n')
647 rnForAll doc forall_tyvars ctxt ty
648 = bindTyVarsFVRn doc forall_tyvars $ \ new_tyvars ->
649 rnContext doc ctxt `thenRn` \ (new_ctxt, cxt_fvs) ->
650 rnHsType doc ty `thenRn` \ (new_ty, ty_fvs) ->
651 returnRn (mkHsForAllTy (Just new_tyvars) new_ctxt new_ty,
652 cxt_fvs `plusFV` ty_fvs)
656 rnContext :: SDoc -> RdrNameContext -> RnMS (RenamedContext, FreeVars)
658 = mapAndUnzipRn rn_pred ctxt `thenRn` \ (theta, fvs_s) ->
660 (_, dups) = removeDupsEq theta
661 -- We only have equality, not ordering
663 -- Check for duplicate assertions
664 -- If this isn't an error, then it ought to be:
665 mapRn (addWarnRn . dupClassAssertWarn theta) dups `thenRn_`
666 returnRn (theta, plusFVs fvs_s)
668 --Someone discovered that @CCallable@ and @CReturnable@
669 -- could be used in contexts such as:
670 -- foo :: CCallable a => a -> PrimIO Int
671 -- Doing this utterly wrecks the whole point of introducing these
672 -- classes so we specifically check that this isn't being done.
673 rn_pred pred = rnPred doc pred `thenRn` \ (pred', fvs)->
674 checkRn (not (bad_pred pred'))
675 (naughtyCCallContextErr pred') `thenRn_`
676 returnRn (pred', fvs)
678 bad_pred (HsPClass clas _) = getUnique clas `elem` cCallishClassKeys
679 bad_pred other = False
682 rnPred doc (HsPClass clas tys)
683 = lookupOccRn clas `thenRn` \ clas_name ->
684 rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
685 returnRn (HsPClass clas_name tys', fvs `addOneFV` clas_name)
687 rnPred doc (HsPIParam n ty)
688 = newIPName n `thenRn` \ name ->
689 rnHsType doc ty `thenRn` \ (ty', fvs) ->
690 returnRn (HsPIParam name ty', fvs)
694 rnFds :: SDoc -> [FunDep RdrName] -> RnMS ([FunDep Name], FreeVars)
697 = mapAndUnzipRn rn_fds fds `thenRn` \ (theta, fvs_s) ->
698 returnRn (theta, plusFVs fvs_s)
701 = rnHsTyVars doc tys1 `thenRn` \ (tys1', fvs1) ->
702 rnHsTyVars doc tys2 `thenRn` \ (tys2', fvs2) ->
703 returnRn ((tys1', tys2'), fvs1 `plusFV` fvs2)
705 rnHsTyVars doc tvs = mapFvRn (rnHsTyvar doc) tvs
707 = lookupOccRn tyvar `thenRn` \ tyvar' ->
708 returnRn (tyvar', unitFV tyvar')
711 %*********************************************************
715 %*********************************************************
718 rnIdInfo (HsStrictness str) = returnRn (HsStrictness str, emptyFVs)
720 rnIdInfo (HsWorker worker)
721 = lookupOccRn worker `thenRn` \ worker' ->
722 returnRn (HsWorker worker', unitFV worker')
724 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ (expr', fvs) ->
725 returnRn (HsUnfold inline expr', fvs)
726 rnIdInfo (HsArity arity) = returnRn (HsArity arity, emptyFVs)
727 rnIdInfo (HsUpdate update) = returnRn (HsUpdate update, emptyFVs)
728 rnIdInfo HsNoCafRefs = returnRn (HsNoCafRefs, emptyFVs)
729 rnIdInfo HsCprInfo = returnRn (HsCprInfo, emptyFVs)
733 @UfCore@ expressions.
736 rnCoreExpr (UfType ty)
737 = rnHsType (text "unfolding type") ty `thenRn` \ (ty', fvs) ->
738 returnRn (UfType ty', fvs)
741 = lookupOccRn v `thenRn` \ v' ->
742 returnRn (UfVar v', unitFV v')
745 = returnRn (UfLit l, emptyFVs)
747 rnCoreExpr (UfLitLit l ty)
748 = rnHsType (text "litlit") ty `thenRn` \ (ty', fvs) ->
749 returnRn (UfLitLit l ty', fvs)
751 rnCoreExpr (UfCCall cc ty)
752 = rnHsType (text "ccall") ty `thenRn` \ (ty', fvs) ->
753 returnRn (UfCCall cc ty', fvs)
755 rnCoreExpr (UfTuple con args)
756 = rnHsTupConWkr con `thenRn` \ (con', fvs1) ->
757 mapFvRn rnCoreExpr args `thenRn` \ (args', fvs2) ->
758 returnRn (UfTuple con' args', fvs1 `plusFV` fvs2)
760 rnCoreExpr (UfApp fun arg)
761 = rnCoreExpr fun `thenRn` \ (fun', fv1) ->
762 rnCoreExpr arg `thenRn` \ (arg', fv2) ->
763 returnRn (UfApp fun' arg', fv1 `plusFV` fv2)
765 rnCoreExpr (UfCase scrut bndr alts)
766 = rnCoreExpr scrut `thenRn` \ (scrut', fvs1) ->
767 bindCoreLocalFVRn bndr ( \ bndr' ->
768 mapFvRn rnCoreAlt alts `thenRn` \ (alts', fvs2) ->
769 returnRn (UfCase scrut' bndr' alts', fvs2)
770 ) `thenRn` \ (case', fvs3) ->
771 returnRn (case', fvs1 `plusFV` fvs3)
773 rnCoreExpr (UfNote note expr)
774 = rnNote note `thenRn` \ (note', fvs1) ->
775 rnCoreExpr expr `thenRn` \ (expr', fvs2) ->
776 returnRn (UfNote note' expr', fvs1 `plusFV` fvs2)
778 rnCoreExpr (UfLam bndr body)
779 = rnCoreBndr bndr $ \ bndr' ->
780 rnCoreExpr body `thenRn` \ (body', fvs) ->
781 returnRn (UfLam bndr' body', fvs)
783 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
784 = rnCoreExpr rhs `thenRn` \ (rhs', fvs1) ->
785 rnCoreBndr bndr ( \ bndr' ->
786 rnCoreExpr body `thenRn` \ (body', fvs2) ->
787 returnRn (UfLet (UfNonRec bndr' rhs') body', fvs2)
788 ) `thenRn` \ (result, fvs3) ->
789 returnRn (result, fvs1 `plusFV` fvs3)
791 rnCoreExpr (UfLet (UfRec pairs) body)
792 = rnCoreBndrs bndrs $ \ bndrs' ->
793 mapFvRn rnCoreExpr rhss `thenRn` \ (rhss', fvs1) ->
794 rnCoreExpr body `thenRn` \ (body', fvs2) ->
795 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body', fvs1 `plusFV` fvs2)
797 (bndrs, rhss) = unzip pairs
801 rnCoreBndr (UfValBinder name ty) thing_inside
802 = rnHsType doc ty `thenRn` \ (ty', fvs1) ->
803 bindCoreLocalFVRn name ( \ name' ->
804 thing_inside (UfValBinder name' ty')
805 ) `thenRn` \ (result, fvs2) ->
806 returnRn (result, fvs1 `plusFV` fvs2)
808 doc = text "unfolding id"
810 rnCoreBndr (UfTyBinder name kind) thing_inside
811 = bindCoreLocalFVRn name $ \ name' ->
812 thing_inside (UfTyBinder name' kind)
814 rnCoreBndrs [] thing_inside = thing_inside []
815 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
816 rnCoreBndrs bs $ \ names' ->
817 thing_inside (name':names')
821 rnCoreAlt (con, bndrs, rhs)
822 = rnUfCon con bndrs `thenRn` \ (con', fvs1) ->
823 bindCoreLocalsFVRn bndrs ( \ bndrs' ->
824 rnCoreExpr rhs `thenRn` \ (rhs', fvs2) ->
825 returnRn ((con', bndrs', rhs'), fvs2)
826 ) `thenRn` \ (result, fvs3) ->
827 returnRn (result, fvs1 `plusFV` fvs3)
830 = rnHsType (text "unfolding coerce") ty `thenRn` \ (ty', fvs) ->
831 returnRn (UfCoerce ty', fvs)
833 rnNote (UfSCC cc) = returnRn (UfSCC cc, emptyFVs)
834 rnNote UfInlineCall = returnRn (UfInlineCall, emptyFVs)
835 rnNote UfInlineMe = returnRn (UfInlineMe, emptyFVs)
839 = returnRn (UfDefault, emptyFVs)
841 rnUfCon (UfTupleAlt tup_con) bndrs
842 = rnHsTupCon tup_con `thenRn` \ (HsTupCon con' _, fvs) ->
843 returnRn (UfDataAlt con', fvs)
844 -- Makes the type checker a little easier
846 rnUfCon (UfDataAlt con) _
847 = lookupOccRn con `thenRn` \ con' ->
848 returnRn (UfDataAlt con', unitFV con')
850 rnUfCon (UfLitAlt lit) _
851 = returnRn (UfLitAlt lit, emptyFVs)
853 rnUfCon (UfLitLitAlt lit ty) _
854 = rnHsType (text "litlit") ty `thenRn` \ (ty', fvs) ->
855 returnRn (UfLitLitAlt lit ty', fvs)
858 %*********************************************************
860 \subsection{Rule shapes}
862 %*********************************************************
864 Check the shape of a transformation rule LHS. Currently
865 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
866 not one of the @forall@'d variables.
869 validRuleLhs foralls lhs
872 check (HsApp e1 e2) = check e1
873 check (HsVar v) | v `notElem` foralls = True
878 %*********************************************************
882 %*********************************************************
885 derivingNonStdClassErr clas
886 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
888 classTyVarNotInOpTyErr clas_tyvar sig
889 = hang (hsep [ptext SLIT("Class type variable"),
890 quotes (ppr clas_tyvar),
891 ptext SLIT("does not appear in method signature")])
895 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
897 forAllWarn doc ty tyvar
898 | not opt_WarnUnusedMatches = returnRn ()
900 = getModeRn `thenRn` \ mode ->
903 InterfaceMode -> returnRn () ; -- Don't warn of unused tyvars in interface files
904 -- unless DEBUG is on, in which case it is slightly
905 -- informative. They can arise from mkRhsTyLam,
906 #endif -- leading to (say) f :: forall a b. [b] -> [b]
910 sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
911 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
913 (ptext SLIT("In") <+> doc))
916 forAllErr doc ty tyvar
918 sep [ptext SLIT("The constrained type variable") <+> quotes (ppr tyvar),
919 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
921 (ptext SLIT("In") <+> doc))
923 badRuleLhsErr name lhs
924 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
925 nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
927 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
930 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
931 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
932 ptext SLIT("does not appear on left hand side")]
934 badExtName :: ExtName -> Message
936 = sep [quotes (ppr ext_nm) <+> ptext SLIT("is not a valid C identifier")]
938 dupClassAssertWarn ctxt (assertion : dups)
939 = sep [hsep [ptext SLIT("Duplicate class assertion"),
940 quotes (ppr assertion),
941 ptext SLIT("in the context:")],
942 nest 4 (pprHsContext ctxt <+> ptext SLIT("..."))]
944 naughtyCCallContextErr (HsPClass clas _)
945 = sep [ptext SLIT("Can't use class") <+> quotes (ppr clas),
946 ptext SLIT("in a context")]