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 OccName ( mkDefaultMethodOcc )
44 import FiniteMap ( elemFM )
45 import PrelInfo ( derivableClassKeys, cCallishClassKeys,
46 deRefStablePtr_RDR, makeStablePtr_RDR,
47 bindIO_RDR, returnIO_RDR
49 import Bag ( bagToList )
50 import List ( partition, nub )
52 import SrcLoc ( SrcLoc )
53 import CmdLineOpts ( opt_GlasgowExts, opt_WarnUnusedMatches ) -- Warn of unused for-all'd tyvars
54 import Unique ( Uniquable(..) )
55 import ErrUtils ( Message )
56 import CStrings ( isCLabelString )
57 import Maybes ( maybeToBool, catMaybes )
61 @rnDecl@ `renames' declarations.
62 It simultaneously performs dependency analysis and precedence parsing.
63 It also does the following error checks:
66 Checks that tyvars are used properly. This includes checking
67 for undefined tyvars, and tyvars in contexts that are ambiguous.
68 (Some of this checking has now been moved to module @TcMonoType@,
69 since we don't have functional dependency information at this point.)
71 Checks that all variable occurences are defined.
73 Checks the @(..)@ etc constraints in the export list.
77 %*********************************************************
79 \subsection{Value declarations}
81 %*********************************************************
84 rnSourceDecls :: [RdrNameHsDecl] -> RnMS ([RenamedHsDecl], FreeVars)
85 -- The decls get reversed, but that's ok
88 = go emptyFVs [] decls
90 -- Fixity and deprecations have been dealt with already; ignore them
91 go fvs ds' [] = returnRn (ds', fvs)
92 go fvs ds' (FixD _:ds) = go fvs ds' ds
93 go fvs ds' (DeprecD _:ds) = go fvs ds' ds
94 go fvs ds' (d:ds) = rnDecl d `thenRn` \(d', fvs') ->
95 go (fvs `plusFV` fvs') (d':ds') ds
99 %*********************************************************
101 \subsection{Value declarations}
103 %*********************************************************
106 -- rnDecl does all the work
107 rnDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
109 rnDecl (ValD binds) = rnTopBinds binds `thenRn` \ (new_binds, fvs) ->
110 returnRn (ValD new_binds, fvs)
113 rnDecl (SigD (IfaceSig name ty id_infos loc))
115 lookupTopBndrRn name `thenRn` \ name' ->
116 rnHsType doc_str ty `thenRn` \ (ty',fvs1) ->
117 mapFvRn rnIdInfo id_infos `thenRn` \ (id_infos', fvs2) ->
118 returnRn (SigD (IfaceSig name' ty' id_infos' loc), fvs1 `plusFV` fvs2)
120 doc_str = text "the interface signature for" <+> quotes (ppr name)
123 %*********************************************************
125 \subsection{Type declarations}
127 %*********************************************************
129 @rnTyDecl@ uses the `global name function' to create a new type
130 declaration in which local names have been replaced by their original
131 names, reporting any unknown names.
133 Renaming type variables is a pain. Because they now contain uniques,
134 it is necessary to pass in an association list which maps a parsed
135 tyvar to its @Name@ representation.
136 In some cases (type signatures of values),
137 it is even necessary to go over the type first
138 in order to get the set of tyvars used by it, make an assoc list,
139 and then go over it again to rename the tyvars!
140 However, we can also do some scoping checks at the same time.
143 rnDecl (TyClD (TyData new_or_data context tycon tyvars condecls nconstrs derivings pragmas src_loc))
144 = pushSrcLocRn src_loc $
145 lookupTopBndrRn tycon `thenRn` \ tycon' ->
146 bindTyVarsFVRn data_doc tyvars $ \ tyvars' ->
147 rnContext data_doc context `thenRn` \ (context', cxt_fvs) ->
148 checkDupOrQualNames data_doc con_names `thenRn_`
149 mapFvRn rnConDecl condecls `thenRn` \ (condecls', con_fvs) ->
150 rnDerivs derivings `thenRn` \ (derivings', deriv_fvs) ->
151 ASSERT(isNoDataPragmas pragmas)
152 returnRn (TyClD (TyData new_or_data context' tycon' tyvars' condecls' nconstrs
153 derivings' noDataPragmas src_loc),
154 cxt_fvs `plusFV` con_fvs `plusFV` deriv_fvs)
156 data_doc = text "the data type declaration for" <+> quotes (ppr tycon)
157 con_names = map conDeclName condecls
159 rnDecl (TyClD (TySynonym name tyvars ty src_loc))
160 = pushSrcLocRn src_loc $
161 lookupTopBndrRn name `thenRn` \ name' ->
162 bindTyVarsFVRn syn_doc tyvars $ \ tyvars' ->
163 rnHsType syn_doc (unquantify ty) `thenRn` \ (ty', ty_fvs) ->
164 returnRn (TyClD (TySynonym name' tyvars' ty' src_loc), ty_fvs)
166 syn_doc = text "the declaration for type synonym" <+> quotes (ppr name)
168 -- For H98 we do *not* universally quantify on the RHS of a synonym
169 -- Silently discard context... but the tyvars in the rest won't be in scope
170 unquantify (HsForAllTy Nothing ctxt ty) | not opt_GlasgowExts = ty
173 rnDecl (TyClD (ClassDecl context cname tyvars fds sigs mbinds pragmas
174 tname dname dwname snames src_loc))
175 = pushSrcLocRn src_loc $
177 lookupTopBndrRn cname `thenRn` \ cname' ->
179 -- Deal with the implicit tycon and datacon name
180 -- They aren't in scope (because they aren't visible to the user)
181 -- and what we want to do is simply look them up in the cache;
182 -- we jolly well ought to get a 'hit' there!
183 -- So the 'Imported' part of this call is not relevant.
184 -- Unclean; but since these two are the only place this happens
185 -- I can't work up the energy to do it more beautifully
186 lookupSysBinder tname `thenRn` \ tname' ->
187 lookupSysBinder dname `thenRn` \ dname' ->
188 lookupSysBinder dwname `thenRn` \ dwname' ->
189 mapRn lookupSysBinder snames `thenRn` \ snames' ->
191 -- Tyvars scope over bindings and context
192 bindTyVarsFV2Rn cls_doc tyvars ( \ clas_tyvar_names tyvars' ->
194 -- Check the superclasses
195 rnContext cls_doc context `thenRn` \ (context', cxt_fvs) ->
197 -- Check the functional dependencies
198 rnFds cls_doc fds `thenRn` \ (fds', fds_fvs) ->
200 -- Check the signatures
202 -- First process the class op sigs, then the fixity sigs.
203 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
205 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
206 mapFvRn (rn_op cname' clas_tyvar_names fds') op_sigs `thenRn` \ (sigs', sig_fvs) ->
208 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
210 renameSigs (okClsDclSig binders) non_op_sigs `thenRn` \ (non_ops', fix_fvs) ->
213 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
214 rnMethodBinds mbinds `thenRn` \ (mbinds', meth_fvs) ->
216 -- Typechecker is responsible for checking that we only
217 -- give default-method bindings for things in this class.
218 -- The renamer *could* check this for class decls, but can't
219 -- for instance decls.
221 ASSERT(isNoClassPragmas pragmas)
222 returnRn (TyClD (ClassDecl context' cname' tyvars' fds' (non_ops' ++ sigs') mbinds'
223 NoClassPragmas tname' dname' dwname' snames' src_loc),
232 cls_doc = text "the declaration for class" <+> ppr cname
233 sig_doc = text "the signatures for class" <+> ppr cname
234 meth_doc = text "the default-methods for class" <+> ppr cname
236 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
237 meth_rdr_names_w_locs = bagToList (collectMonoBinders mbinds)
239 rn_op clas clas_tyvars clas_fds sig@(ClassOpSig op maybe_dm_stuff ty locn)
240 = pushSrcLocRn locn $
241 lookupTopBndrRn op `thenRn` \ op_name ->
243 -- Check the signature
244 rnHsSigType (quotes (ppr op)) ty `thenRn` \ (new_ty, op_ty_fvs) ->
246 check_in_op_ty clas_tyvar =
247 checkRn (clas_tyvar `elemNameSet` oclose clas_fds op_ty_fvs)
248 (classTyVarNotInOpTyErr clas_tyvar sig)
250 mapRn_ check_in_op_ty clas_tyvars `thenRn_`
252 -- Make the default-method name
253 (case maybe_dm_stuff of
254 Nothing -> returnRn (Nothing, emptyFVs) -- Source-file class decl
256 Just (dm_rdr_name, explicit_dm)
257 -> -- Imported class that has a default method decl
258 -- See comments with tname, snames, above
259 lookupSysBinder dm_rdr_name `thenRn` \ dm_name ->
260 returnRn (Just (dm_name, explicit_dm),
261 if explicit_dm then unitFV dm_name else emptyFVs)
262 -- An imported class decl for a class decl that had an explicit default
263 -- method, mentions, rather than defines,
264 -- the default method, so we must arrange to pull it in
265 ) `thenRn` \ (maybe_dm_stuff', dm_fvs) ->
267 returnRn (ClassOpSig op_name maybe_dm_stuff' new_ty locn, op_ty_fvs `plusFV` dm_fvs)
271 %*********************************************************
273 \subsection{Instance declarations}
275 %*********************************************************
278 rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc))
279 = pushSrcLocRn src_loc $
280 rnHsSigType (text "an instance decl") inst_ty `thenRn` \ (inst_ty', inst_fvs) ->
282 inst_tyvars = case inst_ty' of
283 HsForAllTy (Just inst_tyvars) _ _ -> inst_tyvars
285 -- (Slightly strangely) the forall-d tyvars scope over
286 -- the method bindings too
289 -- Rename the bindings
290 -- NB meth_names can be qualified!
291 checkDupNames meth_doc meth_names `thenRn_`
292 extendTyVarEnvFVRn inst_tyvars (
294 ) `thenRn` \ (mbinds', meth_fvs) ->
296 binders = map fst (bagToList (collectMonoBinders mbinds'))
297 binder_set = mkNameSet binders
299 -- Rename the prags and signatures.
300 -- Note that the type variables are not in scope here,
301 -- so that instance Eq a => Eq (T a) where
302 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
305 -- But the (unqualified) method names are in scope
306 bindLocalNames binders (
307 renameSigs (okInstDclSig binder_set) uprags
308 ) `thenRn` \ (new_uprags, prag_fvs) ->
310 (case maybe_dfun_rdr_name of
311 Nothing -> returnRn (Nothing, emptyFVs)
313 Just dfun_rdr_name -> lookupSysBinder dfun_rdr_name `thenRn` \ dfun_name ->
314 returnRn (Just dfun_name, unitFV dfun_name)
315 ) `thenRn` \ (maybe_dfun_name, dfun_fv) ->
317 -- The typechecker checks that all the bindings are for the right class.
318 returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags maybe_dfun_name src_loc),
319 inst_fvs `plusFV` meth_fvs `plusFV` prag_fvs `plusFV` dfun_fv)
321 meth_doc = text "the bindings in an instance declaration"
322 meth_names = bagToList (collectMonoBinders mbinds)
325 %*********************************************************
327 \subsection{Default declarations}
329 %*********************************************************
332 rnDecl (DefD (DefaultDecl tys src_loc))
333 = pushSrcLocRn src_loc $
334 rnHsTypes doc_str tys `thenRn` \ (tys', fvs) ->
335 returnRn (DefD (DefaultDecl tys' src_loc), fvs)
337 doc_str = text "a `default' declaration"
340 %*********************************************************
342 \subsection{Foreign declarations}
344 %*********************************************************
347 rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
348 = pushSrcLocRn src_loc $
349 lookupOccRn name `thenRn` \ name' ->
352 | isDyn = lookupOrigNames [makeStablePtr_RDR, deRefStablePtr_RDR,
353 bindIO_RDR, returnIO_RDR]
355 lookupOrigNames [bindIO_RDR, returnIO_RDR] `thenRn` \ fvs ->
356 returnRn (addOneFV fvs name')
357 extra_fvs other = returnRn emptyFVs
359 checkRn (ok_ext_nm ext_nm) (badExtName ext_nm) `thenRn_`
361 extra_fvs imp_exp `thenRn` \ fvs1 ->
363 rnHsSigType fo_decl_msg ty `thenRn` \ (ty', fvs2) ->
364 returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc),
367 fo_decl_msg = ptext SLIT("a foreign declaration")
368 isDyn = isDynamicExtName ext_nm
370 ok_ext_nm Dynamic = True
371 ok_ext_nm (ExtName nm (Just mb)) = isCLabelString nm && isCLabelString mb
372 ok_ext_nm (ExtName nm Nothing) = isCLabelString nm
375 %*********************************************************
379 %*********************************************************
382 rnDecl (RuleD (IfaceRule rule_name vars fn args rhs src_loc))
383 = pushSrcLocRn src_loc $
384 lookupOccRn fn `thenRn` \ fn' ->
385 rnCoreBndrs vars $ \ vars' ->
386 mapFvRn rnCoreExpr args `thenRn` \ (args', fvs1) ->
387 rnCoreExpr rhs `thenRn` \ (rhs', fvs2) ->
388 returnRn (RuleD (IfaceRule rule_name vars' fn' args' rhs' src_loc),
389 (fvs1 `plusFV` fvs2) `addOneFV` fn')
391 rnDecl (RuleD (IfaceRuleOut fn rule))
392 -- This one is used for BuiltInRules
393 -- The rule itself is already done, but the thing
394 -- to attach it to is not.
395 = lookupOccRn fn `thenRn` \ fn' ->
396 returnRn (RuleD (IfaceRuleOut fn' rule), unitFV fn')
398 rnDecl (RuleD (HsRule rule_name tvs vars lhs rhs src_loc))
400 pushSrcLocRn src_loc $
402 bindTyVarsFV2Rn doc (map UserTyVar sig_tvs) $ \ sig_tvs' _ ->
403 bindLocalsFVRn doc (map get_var vars) $ \ ids ->
404 mapFvRn rn_var (vars `zip` ids) `thenRn` \ (vars', fv_vars) ->
406 rnExpr lhs `thenRn` \ (lhs', fv_lhs) ->
407 rnExpr rhs `thenRn` \ (rhs', fv_rhs) ->
408 checkRn (validRuleLhs ids lhs')
409 (badRuleLhsErr rule_name lhs') `thenRn_`
411 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
413 mapRn (addErrRn . badRuleVar rule_name) bad_vars `thenRn_`
414 returnRn (RuleD (HsRule rule_name sig_tvs' vars' lhs' rhs' src_loc),
415 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
417 doc = text "the transformation rule" <+> ptext rule_name
418 sig_tvs = extractRuleBndrsTyVars vars
420 get_var (RuleBndr v) = v
421 get_var (RuleBndrSig v _) = v
423 rn_var (RuleBndr v, id) = returnRn (RuleBndr id, emptyFVs)
424 rn_var (RuleBndrSig v t, id) = rnHsType doc t `thenRn` \ (t', fvs) ->
425 returnRn (RuleBndrSig id t', fvs)
429 %*********************************************************
431 \subsection{Support code for type/data declarations}
433 %*********************************************************
436 rnDerivs :: Maybe [RdrName] -> RnMS (Maybe [Name], FreeVars)
438 rnDerivs Nothing -- derivs not specified
439 = returnRn (Nothing, emptyFVs)
442 = mapRn do_one clss `thenRn` \ clss' ->
443 returnRn (Just clss', mkNameSet clss')
445 do_one cls = lookupOccRn cls `thenRn` \ clas_name ->
446 checkRn (getUnique clas_name `elem` derivableClassKeys)
447 (derivingNonStdClassErr clas_name) `thenRn_`
452 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
453 conDeclName (ConDecl n _ _ _ _ l) = (n,l)
455 rnConDecl :: RdrNameConDecl -> RnMS (RenamedConDecl, FreeVars)
456 rnConDecl (ConDecl name wkr tvs cxt details locn)
457 = pushSrcLocRn locn $
458 checkConName name `thenRn_`
459 lookupTopBndrRn name `thenRn` \ new_name ->
461 lookupSysBinder wkr `thenRn` \ new_wkr ->
462 -- See comments with ClassDecl
464 bindTyVarsFVRn doc tvs $ \ new_tyvars ->
465 rnContext doc cxt `thenRn` \ (new_context, cxt_fvs) ->
466 rnConDetails doc locn details `thenRn` \ (new_details, det_fvs) ->
467 returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn,
468 cxt_fvs `plusFV` det_fvs)
470 doc = text "the definition of data constructor" <+> quotes (ppr name)
472 rnConDetails doc locn (VanillaCon tys)
473 = mapFvRn (rnBangTy doc) tys `thenRn` \ (new_tys, fvs) ->
474 returnRn (VanillaCon new_tys, fvs)
476 rnConDetails doc locn (InfixCon ty1 ty2)
477 = rnBangTy doc ty1 `thenRn` \ (new_ty1, fvs1) ->
478 rnBangTy doc ty2 `thenRn` \ (new_ty2, fvs2) ->
479 returnRn (InfixCon new_ty1 new_ty2, fvs1 `plusFV` fvs2)
481 rnConDetails doc locn (NewCon ty mb_field)
482 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
483 rn_field mb_field `thenRn` \ new_mb_field ->
484 returnRn (NewCon new_ty new_mb_field, fvs)
486 rn_field Nothing = returnRn Nothing
488 lookupTopBndrRn f `thenRn` \ new_f ->
489 returnRn (Just new_f)
491 rnConDetails doc locn (RecCon fields)
492 = checkDupOrQualNames doc field_names `thenRn_`
493 mapFvRn (rnField doc) fields `thenRn` \ (new_fields, fvs) ->
494 returnRn (RecCon new_fields, fvs)
496 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
498 rnField doc (names, ty)
499 = mapRn lookupTopBndrRn names `thenRn` \ new_names ->
500 rnBangTy doc ty `thenRn` \ (new_ty, fvs) ->
501 returnRn ((new_names, new_ty), fvs)
503 rnBangTy doc (Banged ty)
504 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
505 returnRn (Banged new_ty, fvs)
507 rnBangTy doc (Unbanged ty)
508 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
509 returnRn (Unbanged new_ty, fvs)
511 rnBangTy doc (Unpacked ty)
512 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
513 returnRn (Unpacked new_ty, fvs)
515 -- This data decl will parse OK
517 -- treating "a" as the constructor.
518 -- It is really hard to make the parser spot this malformation.
519 -- So the renamer has to check that the constructor is legal
521 -- We can get an operator as the constructor, even in the prefix form:
522 -- data T = :% Int Int
523 -- from interface files, which always print in prefix form
526 = checkRn (isRdrDataCon name)
531 %*********************************************************
533 \subsection{Support code to rename types}
535 %*********************************************************
538 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
539 -- rnHsSigType is used for source-language type signatures,
540 -- which use *implicit* universal quantification.
541 rnHsSigType doc_str ty
542 = rnHsType (text "the type signature for" <+> doc_str) ty
544 ---------------------------------------
545 rnHsType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
547 rnHsType doc (HsForAllTy Nothing ctxt ty)
548 -- Implicit quantifiction in source code (no kinds on tyvars)
549 -- Given the signature C => T we universally quantify
550 -- over FV(T) \ {in-scope-tyvars}
551 = getLocalNameEnv `thenRn` \ name_env ->
553 mentioned_in_tau = extractHsTyRdrTyVars ty
554 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
555 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
556 forall_tyvars = filter (not . (`elemFM` name_env)) mentioned
558 rnForAll doc (map UserTyVar forall_tyvars) ctxt ty
560 rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
561 -- Explicit quantification.
562 -- Check that the forall'd tyvars are actually
563 -- mentioned in the type, and produce a warning if not
565 mentioned_in_tau = extractHsTyRdrTyVars tau
566 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
567 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
568 forall_tyvar_names = hsTyVarNames forall_tyvars
570 -- Explicitly quantified but not mentioned in ctxt or tau
571 warn_guys = filter (`notElem` mentioned) forall_tyvar_names
573 mapRn_ (forAllWarn doc tau) warn_guys `thenRn_`
574 rnForAll doc forall_tyvars ctxt tau
576 rnHsType doc (HsTyVar tyvar)
577 = lookupOccRn tyvar `thenRn` \ tyvar' ->
578 returnRn (HsTyVar tyvar', unitFV tyvar')
580 rnHsType doc (HsFunTy ty1 ty2)
581 = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
582 -- Might find a for-all as the arg of a function type
583 rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
584 -- Or as the result. This happens when reading Prelude.hi
585 -- when we find return :: forall m. Monad m -> forall a. a -> m a
586 returnRn (HsFunTy ty1' ty2', fvs1 `plusFV` fvs2)
588 rnHsType doc (HsListTy ty)
589 = rnHsType doc ty `thenRn` \ (ty', fvs) ->
590 returnRn (HsListTy ty', fvs `addOneFV` listTyCon_name)
592 -- Unboxed tuples are allowed to have poly-typed arguments. These
593 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
594 rnHsType doc (HsTupleTy (HsTupCon _ boxity) tys)
595 -- Don't do lookupOccRn, because this is built-in syntax
596 -- so it doesn't need to be in scope
597 = mapFvRn (rnHsType doc) tys `thenRn` \ (tys', fvs) ->
598 returnRn (HsTupleTy (HsTupCon n' boxity) tys', fvs `addOneFV` n')
600 n' = tupleTyCon_name boxity (length tys)
603 rnHsType doc (HsAppTy ty1 ty2)
604 = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
605 rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
606 returnRn (HsAppTy ty1' ty2', fvs1 `plusFV` fvs2)
608 rnHsType doc (HsPredTy pred)
609 = rnPred doc pred `thenRn` \ (pred', fvs) ->
610 returnRn (HsPredTy pred', fvs)
612 rnHsType doc (HsUsgForAllTy uv_rdr ty)
613 = bindUVarRn doc uv_rdr $ \ uv_name ->
614 rnHsType doc ty `thenRn` \ (ty', fvs) ->
615 returnRn (HsUsgForAllTy uv_name ty',
618 rnHsType doc (HsUsgTy usg ty)
619 = newUsg usg `thenRn` \ (usg', usg_fvs) ->
620 rnHsType doc ty `thenRn` \ (ty', ty_fvs) ->
621 -- A for-all can occur inside a usage annotation
622 returnRn (HsUsgTy usg' ty',
623 usg_fvs `plusFV` ty_fvs)
625 newUsg usg = case usg of
626 HsUsOnce -> returnRn (HsUsOnce, emptyFVs)
627 HsUsMany -> returnRn (HsUsMany, emptyFVs)
628 HsUsVar uv_rdr -> lookupOccRn uv_rdr `thenRn` \ uv_name ->
629 returnRn (HsUsVar uv_name, emptyFVs)
631 rnHsTypes doc tys = mapFvRn (rnHsType doc) tys
635 -- We use lookupOcc here because this is interface file only stuff
636 -- and we need the workers...
637 rnHsTupCon (HsTupCon n boxity)
638 = lookupOccRn n `thenRn` \ n' ->
639 returnRn (HsTupCon n' boxity, unitFV n')
641 rnHsTupConWkr (HsTupCon n boxity)
642 -- Tuple construtors are for the *worker* of the tuple
643 -- Going direct saves needless messing about
644 = lookupOccRn (mkRdrNameWkr n) `thenRn` \ n' ->
645 returnRn (HsTupCon n' boxity, unitFV n')
649 rnForAll doc forall_tyvars ctxt ty
650 = bindTyVarsFVRn doc forall_tyvars $ \ new_tyvars ->
651 rnContext doc ctxt `thenRn` \ (new_ctxt, cxt_fvs) ->
652 rnHsType doc ty `thenRn` \ (new_ty, ty_fvs) ->
653 returnRn (mkHsForAllTy (Just new_tyvars) new_ctxt new_ty,
654 cxt_fvs `plusFV` ty_fvs)
658 rnContext :: SDoc -> RdrNameContext -> RnMS (RenamedContext, FreeVars)
660 = mapAndUnzipRn rn_pred ctxt `thenRn` \ (theta, fvs_s) ->
662 (_, dups) = removeDupsEq theta
663 -- We only have equality, not ordering
665 -- Check for duplicate assertions
666 -- If this isn't an error, then it ought to be:
667 mapRn (addWarnRn . dupClassAssertWarn theta) dups `thenRn_`
668 returnRn (theta, plusFVs fvs_s)
670 --Someone discovered that @CCallable@ and @CReturnable@
671 -- could be used in contexts such as:
672 -- foo :: CCallable a => a -> PrimIO Int
673 -- Doing this utterly wrecks the whole point of introducing these
674 -- classes so we specifically check that this isn't being done.
675 rn_pred pred = rnPred doc pred `thenRn` \ (pred', fvs)->
676 checkRn (not (bad_pred pred'))
677 (naughtyCCallContextErr pred') `thenRn_`
678 returnRn (pred', fvs)
680 bad_pred (HsPClass clas _) = getUnique clas `elem` cCallishClassKeys
681 bad_pred other = False
684 rnPred doc (HsPClass clas tys)
685 = lookupOccRn clas `thenRn` \ clas_name ->
686 rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
687 returnRn (HsPClass clas_name tys', fvs `addOneFV` clas_name)
689 rnPred doc (HsPIParam n ty)
690 = newIPName n `thenRn` \ name ->
691 rnHsType doc ty `thenRn` \ (ty', fvs) ->
692 returnRn (HsPIParam name ty', fvs)
696 rnFds :: SDoc -> [FunDep RdrName] -> RnMS ([FunDep Name], FreeVars)
699 = mapAndUnzipRn rn_fds fds `thenRn` \ (theta, fvs_s) ->
700 returnRn (theta, plusFVs fvs_s)
703 = rnHsTyVars doc tys1 `thenRn` \ (tys1', fvs1) ->
704 rnHsTyVars doc tys2 `thenRn` \ (tys2', fvs2) ->
705 returnRn ((tys1', tys2'), fvs1 `plusFV` fvs2)
707 rnHsTyVars doc tvs = mapFvRn (rnHsTyvar doc) tvs
709 = lookupOccRn tyvar `thenRn` \ tyvar' ->
710 returnRn (tyvar', unitFV tyvar')
713 %*********************************************************
717 %*********************************************************
720 rnIdInfo (HsStrictness str) = returnRn (HsStrictness str, emptyFVs)
722 rnIdInfo (HsWorker worker)
723 = lookupOccRn worker `thenRn` \ worker' ->
724 returnRn (HsWorker worker', unitFV worker')
726 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ (expr', fvs) ->
727 returnRn (HsUnfold inline expr', fvs)
728 rnIdInfo (HsArity arity) = returnRn (HsArity arity, emptyFVs)
729 rnIdInfo (HsUpdate update) = returnRn (HsUpdate update, emptyFVs)
730 rnIdInfo HsNoCafRefs = returnRn (HsNoCafRefs, emptyFVs)
731 rnIdInfo HsCprInfo = returnRn (HsCprInfo, emptyFVs)
735 @UfCore@ expressions.
738 rnCoreExpr (UfType ty)
739 = rnHsType (text "unfolding type") ty `thenRn` \ (ty', fvs) ->
740 returnRn (UfType ty', fvs)
743 = lookupOccRn v `thenRn` \ v' ->
744 returnRn (UfVar v', unitFV v')
747 = returnRn (UfLit l, emptyFVs)
749 rnCoreExpr (UfLitLit l ty)
750 = rnHsType (text "litlit") ty `thenRn` \ (ty', fvs) ->
751 returnRn (UfLitLit l ty', fvs)
753 rnCoreExpr (UfCCall cc ty)
754 = rnHsType (text "ccall") ty `thenRn` \ (ty', fvs) ->
755 returnRn (UfCCall cc ty', fvs)
757 rnCoreExpr (UfTuple con args)
758 = rnHsTupConWkr con `thenRn` \ (con', fvs1) ->
759 mapFvRn rnCoreExpr args `thenRn` \ (args', fvs2) ->
760 returnRn (UfTuple con' args', fvs1 `plusFV` fvs2)
762 rnCoreExpr (UfApp fun arg)
763 = rnCoreExpr fun `thenRn` \ (fun', fv1) ->
764 rnCoreExpr arg `thenRn` \ (arg', fv2) ->
765 returnRn (UfApp fun' arg', fv1 `plusFV` fv2)
767 rnCoreExpr (UfCase scrut bndr alts)
768 = rnCoreExpr scrut `thenRn` \ (scrut', fvs1) ->
769 bindCoreLocalFVRn bndr ( \ bndr' ->
770 mapFvRn rnCoreAlt alts `thenRn` \ (alts', fvs2) ->
771 returnRn (UfCase scrut' bndr' alts', fvs2)
772 ) `thenRn` \ (case', fvs3) ->
773 returnRn (case', fvs1 `plusFV` fvs3)
775 rnCoreExpr (UfNote note expr)
776 = rnNote note `thenRn` \ (note', fvs1) ->
777 rnCoreExpr expr `thenRn` \ (expr', fvs2) ->
778 returnRn (UfNote note' expr', fvs1 `plusFV` fvs2)
780 rnCoreExpr (UfLam bndr body)
781 = rnCoreBndr bndr $ \ bndr' ->
782 rnCoreExpr body `thenRn` \ (body', fvs) ->
783 returnRn (UfLam bndr' body', fvs)
785 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
786 = rnCoreExpr rhs `thenRn` \ (rhs', fvs1) ->
787 rnCoreBndr bndr ( \ bndr' ->
788 rnCoreExpr body `thenRn` \ (body', fvs2) ->
789 returnRn (UfLet (UfNonRec bndr' rhs') body', fvs2)
790 ) `thenRn` \ (result, fvs3) ->
791 returnRn (result, fvs1 `plusFV` fvs3)
793 rnCoreExpr (UfLet (UfRec pairs) body)
794 = rnCoreBndrs bndrs $ \ bndrs' ->
795 mapFvRn rnCoreExpr rhss `thenRn` \ (rhss', fvs1) ->
796 rnCoreExpr body `thenRn` \ (body', fvs2) ->
797 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body', fvs1 `plusFV` fvs2)
799 (bndrs, rhss) = unzip pairs
803 rnCoreBndr (UfValBinder name ty) thing_inside
804 = rnHsType doc ty `thenRn` \ (ty', fvs1) ->
805 bindCoreLocalFVRn name ( \ name' ->
806 thing_inside (UfValBinder name' ty')
807 ) `thenRn` \ (result, fvs2) ->
808 returnRn (result, fvs1 `plusFV` fvs2)
810 doc = text "unfolding id"
812 rnCoreBndr (UfTyBinder name kind) thing_inside
813 = bindCoreLocalFVRn name $ \ name' ->
814 thing_inside (UfTyBinder name' kind)
816 rnCoreBndrs [] thing_inside = thing_inside []
817 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
818 rnCoreBndrs bs $ \ names' ->
819 thing_inside (name':names')
823 rnCoreAlt (con, bndrs, rhs)
824 = rnUfCon con bndrs `thenRn` \ (con', fvs1) ->
825 bindCoreLocalsFVRn bndrs ( \ bndrs' ->
826 rnCoreExpr rhs `thenRn` \ (rhs', fvs2) ->
827 returnRn ((con', bndrs', rhs'), fvs2)
828 ) `thenRn` \ (result, fvs3) ->
829 returnRn (result, fvs1 `plusFV` fvs3)
832 = rnHsType (text "unfolding coerce") ty `thenRn` \ (ty', fvs) ->
833 returnRn (UfCoerce ty', fvs)
835 rnNote (UfSCC cc) = returnRn (UfSCC cc, emptyFVs)
836 rnNote UfInlineCall = returnRn (UfInlineCall, emptyFVs)
837 rnNote UfInlineMe = returnRn (UfInlineMe, emptyFVs)
841 = returnRn (UfDefault, emptyFVs)
843 rnUfCon (UfTupleAlt tup_con) bndrs
844 = rnHsTupCon tup_con `thenRn` \ (HsTupCon con' _, fvs) ->
845 returnRn (UfDataAlt con', fvs)
846 -- Makes the type checker a little easier
848 rnUfCon (UfDataAlt con) _
849 = lookupOccRn con `thenRn` \ con' ->
850 returnRn (UfDataAlt con', unitFV con')
852 rnUfCon (UfLitAlt lit) _
853 = returnRn (UfLitAlt lit, emptyFVs)
855 rnUfCon (UfLitLitAlt lit ty) _
856 = rnHsType (text "litlit") ty `thenRn` \ (ty', fvs) ->
857 returnRn (UfLitLitAlt lit ty', fvs)
860 %*********************************************************
862 \subsection{Rule shapes}
864 %*********************************************************
866 Check the shape of a transformation rule LHS. Currently
867 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
868 not one of the @forall@'d variables.
871 validRuleLhs foralls lhs
874 check (HsApp e1 e2) = check e1
875 check (HsVar v) | v `notElem` foralls = True
880 %*********************************************************
884 %*********************************************************
887 derivingNonStdClassErr clas
888 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
890 classTyVarNotInOpTyErr clas_tyvar sig
891 = hang (hsep [ptext SLIT("Class type variable"),
892 quotes (ppr clas_tyvar),
893 ptext SLIT("does not appear in method signature")])
897 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
899 forAllWarn doc ty tyvar
900 | not opt_WarnUnusedMatches = returnRn ()
902 = getModeRn `thenRn` \ mode ->
905 InterfaceMode -> returnRn () ; -- Don't warn of unused tyvars in interface files
906 -- unless DEBUG is on, in which case it is slightly
907 -- informative. They can arise from mkRhsTyLam,
908 #endif -- leading to (say) f :: forall a b. [b] -> [b]
912 sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
913 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
915 (ptext SLIT("In") <+> doc))
918 forAllErr doc ty tyvar
920 sep [ptext SLIT("The constrained type variable") <+> quotes (ppr tyvar),
921 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
923 (ptext SLIT("In") <+> doc))
925 badRuleLhsErr name lhs
926 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
927 nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
929 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
932 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
933 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
934 ptext SLIT("does not appear on left hand side")]
936 badExtName :: ExtName -> Message
938 = sep [quotes (ppr ext_nm) <+> ptext SLIT("is not a valid C identifier")]
940 dupClassAssertWarn ctxt (assertion : dups)
941 = sep [hsep [ptext SLIT("Duplicate class assertion"),
942 quotes (ppr assertion),
943 ptext SLIT("in the context:")],
944 nest 4 (pprHsContext ctxt <+> ptext SLIT("..."))]
946 naughtyCCallContextErr (HsPClass clas _)
947 = sep [ptext SLIT("Can't use class") <+> quotes (ppr clas),
948 ptext SLIT("in a context")]