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, mkRdrNameWkr )
16 import RdrHsSyn ( RdrNameContext, RdrNameHsType, RdrNameConDecl,
17 extractRuleBndrsTyVars, extractHsTyRdrTyVars,
18 extractHsCtxtRdrTyVars, extractGenericPatTyVars
23 import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs )
24 import RnEnv ( lookupTopBndrRn, lookupOccRn, newIPName,
25 lookupOrigNames, lookupSysBinder, newLocalsRn,
26 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, DefMeth (..) )
37 import Name ( Name, OccName, nameOccName, NamedThing(..) )
39 import OccName ( mkDefaultMethodOcc, isTvOcc )
40 import FiniteMap ( elemFM )
41 import PrelInfo ( derivableClassKeys, cCallishClassKeys )
42 import PrelNames ( deRefStablePtr_RDR, makeStablePtr_RDR,
43 bindIO_RDR, returnIO_RDR
45 import Bag ( bagToList )
46 import List ( partition, nub )
48 import SrcLoc ( SrcLoc )
49 import CmdLineOpts ( opt_WarnUnusedMatches, dopt_GlasgowExts ) -- Warn of unused for-all'd tyvars
50 import Unique ( Uniquable(..) )
51 import ErrUtils ( Message )
52 import CStrings ( isCLabelString )
53 import ListSetOps ( minusList, removeDupsEq )
56 @rnDecl@ `renames' declarations.
57 It simultaneously performs dependency analysis and precedence parsing.
58 It also does the following error checks:
61 Checks that tyvars are used properly. This includes checking
62 for undefined tyvars, and tyvars in contexts that are ambiguous.
63 (Some of this checking has now been moved to module @TcMonoType@,
64 since we don't have functional dependency information at this point.)
66 Checks that all variable occurences are defined.
68 Checks the @(..)@ etc constraints in the export list.
72 %*********************************************************
74 \subsection{Value declarations}
76 %*********************************************************
79 rnSourceDecls :: [RdrNameHsDecl] -> RnMS ([RenamedHsDecl], FreeVars)
80 -- The decls get reversed, but that's ok
83 = go emptyFVs [] decls
85 -- Fixity and deprecations have been dealt with already; ignore them
86 go fvs ds' [] = returnRn (ds', fvs)
87 go fvs ds' (FixD _:ds) = go fvs ds' ds
88 go fvs ds' (DeprecD _:ds) = go fvs ds' ds
89 go fvs ds' (d:ds) = rnDecl d `thenRn` \(d', fvs') ->
90 go (fvs `plusFV` fvs') (d':ds') ds
94 %*********************************************************
96 \subsection{Value declarations}
98 %*********************************************************
101 -- rnDecl does all the work
102 rnDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
104 rnDecl (ValD binds) = rnTopBinds binds `thenRn` \ (new_binds, fvs) ->
105 returnRn (ValD new_binds, fvs)
108 rnDecl (SigD (IfaceSig name ty id_infos loc))
110 lookupTopBndrRn name `thenRn` \ name' ->
111 rnHsType doc_str ty `thenRn` \ (ty',fvs1) ->
112 mapFvRn rnIdInfo id_infos `thenRn` \ (id_infos', fvs2) ->
113 returnRn (SigD (IfaceSig name' ty' id_infos' loc), fvs1 `plusFV` fvs2)
115 doc_str = text "the interface signature for" <+> quotes (ppr name)
118 %*********************************************************
120 \subsection{Type declarations}
122 %*********************************************************
124 @rnTyDecl@ uses the `global name function' to create a new type
125 declaration in which local names have been replaced by their original
126 names, reporting any unknown names.
128 Renaming type variables is a pain. Because they now contain uniques,
129 it is necessary to pass in an association list which maps a parsed
130 tyvar to its @Name@ representation.
131 In some cases (type signatures of values),
132 it is even necessary to go over the type first
133 in order to get the set of tyvars used by it, make an assoc list,
134 and then go over it again to rename the tyvars!
135 However, we can also do some scoping checks at the same time.
138 rnDecl (TyClD (TyData new_or_data context tycon tyvars condecls nconstrs derivings pragmas src_loc gen_name1 gen_name2))
139 = pushSrcLocRn src_loc $
140 lookupTopBndrRn tycon `thenRn` \ tycon' ->
141 bindTyVarsFVRn data_doc tyvars $ \ tyvars' ->
142 rnContext data_doc context `thenRn` \ (context', cxt_fvs) ->
143 checkDupOrQualNames data_doc con_names `thenRn_`
144 mapFvRn rnConDecl condecls `thenRn` \ (condecls', con_fvs) ->
145 lookupSysBinder gen_name1 `thenRn` \ name1' ->
146 lookupSysBinder gen_name2 `thenRn` \ name2' ->
147 rnDerivs derivings `thenRn` \ (derivings', deriv_fvs) ->
148 ASSERT(isNoDataPragmas pragmas)
149 returnRn (TyClD (TyData new_or_data context' tycon' tyvars' condecls' nconstrs
150 derivings' noDataPragmas src_loc name1' name2'),
151 cxt_fvs `plusFV` con_fvs `plusFV` deriv_fvs)
153 data_doc = text "the data type declaration for" <+> quotes (ppr tycon)
154 con_names = map conDeclName condecls
156 rnDecl (TyClD (TySynonym name tyvars ty src_loc))
157 = pushSrcLocRn src_loc $
158 doptsRn dopt_GlasgowExts `thenRn` \ glaExts ->
159 lookupTopBndrRn name `thenRn` \ name' ->
160 bindTyVarsFVRn syn_doc tyvars $ \ tyvars' ->
161 rnHsType syn_doc (unquantify glaExts 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 glaExts (HsForAllTy Nothing ctxt ty) | glaExts = ty
169 unquantify glaExys ty = ty
171 rnDecl (TyClD (ClassDecl context cname tyvars fds sigs mbinds pragmas
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
185 mapRn lookupSysBinder names `thenRn` \ names' ->
187 -- Tyvars scope over bindings and context
188 bindTyVarsFV2Rn cls_doc tyvars ( \ clas_tyvar_names tyvars' ->
190 -- Check the superclasses
191 rnContext cls_doc context `thenRn` \ (context', cxt_fvs) ->
193 -- Check the functional dependencies
194 rnFds cls_doc fds `thenRn` \ (fds', fds_fvs) ->
196 -- Check the signatures
197 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
199 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
200 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
202 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
203 mapFvRn (rn_op cname' clas_tyvar_names fds') op_sigs `thenRn` \ (sigs', sig_fvs) ->
205 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
207 renameSigs (okClsDclSig binders) non_op_sigs `thenRn` \ (non_ops', fix_fvs) ->
210 -- The newLocals call is tiresome: given a generic class decl
213 -- op {| x+y |} (Inl a) = ...
214 -- op {| x+y |} (Inr b) = ...
215 -- op {| a*b |} (a*b) = ...
216 -- we want to name both "x" tyvars with the same unique, so that they are
217 -- easy to group together in the typechecker.
219 getLocalNameEnv `thenRn` \ name_env ->
221 meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
222 gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
223 not (tv `elemFM` name_env)]
225 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
226 newLocalsRn mkLocalName gen_rdr_tyvars_w_locs `thenRn` \ gen_tyvars ->
227 rnMethodBinds gen_tyvars mbinds `thenRn` \ (mbinds', meth_fvs) ->
229 -- Typechecker is responsible for checking that we only
230 -- give default-method bindings for things in this class.
231 -- The renamer *could* check this for class decls, but can't
232 -- for instance decls.
234 ASSERT(isNoClassPragmas pragmas)
235 returnRn (TyClD (ClassDecl context' cname' tyvars' fds' (non_ops' ++ sigs') mbinds'
236 NoClassPragmas names' src_loc),
246 cls_doc = text "the declaration for class" <+> ppr cname
247 sig_doc = text "the signatures for class" <+> ppr cname
248 meth_doc = text "the default-methods for class" <+> ppr cname
250 rn_op clas clas_tyvars clas_fds sig@(ClassOpSig op maybe_dm_stuff ty locn)
251 = pushSrcLocRn locn $
252 lookupTopBndrRn op `thenRn` \ op_name ->
254 -- Check the signature
255 rnHsSigType (quotes (ppr op)) ty `thenRn` \ (new_ty, op_ty_fvs) ->
257 check_in_op_ty clas_tyvar =
258 checkRn (clas_tyvar `elemNameSet` oclose clas_fds op_ty_fvs)
259 (classTyVarNotInOpTyErr clas_tyvar sig)
261 mapRn_ check_in_op_ty clas_tyvars `thenRn_`
263 -- Make the default-method name
264 (case maybe_dm_stuff of
265 Nothing -> returnRn (Nothing, emptyFVs) -- Source-file class decl
267 Just (DefMeth dm_rdr_name)
268 -> -- Imported class that has a default method decl
269 -- See comments with tname, snames, above
270 lookupSysBinder dm_rdr_name `thenRn` \ dm_name ->
271 returnRn (Just (DefMeth dm_name), unitFV dm_name)
272 -- An imported class decl for a class decl that had an explicit default
273 -- method, mentions, rather than defines,
274 -- the default method, so we must arrange to pull it in
276 -> returnRn (Just GenDefMeth, emptyFVs)
278 -> returnRn (Just NoDefMeth, emptyFVs)
279 ) `thenRn` \ (maybe_dm_stuff', dm_fvs) ->
281 returnRn (ClassOpSig op_name maybe_dm_stuff' new_ty locn, op_ty_fvs `plusFV` dm_fvs)
285 %*********************************************************
287 \subsection{Instance declarations}
289 %*********************************************************
292 rnDecl (InstD (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc))
293 = pushSrcLocRn src_loc $
294 rnHsSigType (text "an instance decl") inst_ty `thenRn` \ (inst_ty', inst_fvs) ->
296 inst_tyvars = case inst_ty' of
297 HsForAllTy (Just inst_tyvars) _ _ -> inst_tyvars
299 -- (Slightly strangely) the forall-d tyvars scope over
300 -- the method bindings too
303 -- Rename the bindings
304 -- NB meth_names can be qualified!
305 checkDupNames meth_doc meth_names `thenRn_`
306 extendTyVarEnvFVRn (map hsTyVarName inst_tyvars) (
307 rnMethodBinds [] mbinds
308 ) `thenRn` \ (mbinds', meth_fvs) ->
310 binders = collectMonoBinders mbinds'
311 binder_set = mkNameSet binders
313 -- Rename the prags and signatures.
314 -- Note that the type variables are not in scope here,
315 -- so that instance Eq a => Eq (T a) where
316 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
319 -- But the (unqualified) method names are in scope
320 bindLocalNames binders (
321 renameSigs (okInstDclSig binder_set) uprags
322 ) `thenRn` \ (new_uprags, prag_fvs) ->
324 (case maybe_dfun_rdr_name of
325 Nothing -> returnRn (Nothing, emptyFVs)
327 Just dfun_rdr_name -> lookupSysBinder dfun_rdr_name `thenRn` \ dfun_name ->
328 returnRn (Just dfun_name, unitFV dfun_name)
329 ) `thenRn` \ (maybe_dfun_name, dfun_fv) ->
331 -- The typechecker checks that all the bindings are for the right class.
332 returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags maybe_dfun_name src_loc),
333 inst_fvs `plusFV` meth_fvs `plusFV` prag_fvs `plusFV` dfun_fv)
335 meth_doc = text "the bindings in an instance declaration"
336 meth_names = collectLocatedMonoBinders mbinds
339 %*********************************************************
341 \subsection{Default declarations}
343 %*********************************************************
346 rnDecl (DefD (DefaultDecl tys src_loc))
347 = pushSrcLocRn src_loc $
348 rnHsTypes doc_str tys `thenRn` \ (tys', fvs) ->
349 returnRn (DefD (DefaultDecl tys' src_loc), fvs)
351 doc_str = text "a `default' declaration"
354 %*********************************************************
356 \subsection{Foreign declarations}
358 %*********************************************************
361 rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
362 = pushSrcLocRn src_loc $
363 lookupOccRn name `thenRn` \ name' ->
366 | isDyn = lookupOrigNames [makeStablePtr_RDR, deRefStablePtr_RDR,
367 bindIO_RDR, returnIO_RDR]
369 lookupOrigNames [bindIO_RDR, returnIO_RDR] `thenRn` \ fvs ->
370 returnRn (addOneFV fvs name')
371 extra_fvs other = returnRn emptyFVs
373 checkRn (ok_ext_nm ext_nm) (badExtName ext_nm) `thenRn_`
375 extra_fvs imp_exp `thenRn` \ fvs1 ->
377 rnHsSigType fo_decl_msg ty `thenRn` \ (ty', fvs2) ->
378 returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc),
381 fo_decl_msg = ptext SLIT("a foreign declaration")
382 isDyn = isDynamicExtName ext_nm
384 ok_ext_nm Dynamic = True
385 ok_ext_nm (ExtName nm (Just mb)) = isCLabelString nm && isCLabelString mb
386 ok_ext_nm (ExtName nm Nothing) = isCLabelString nm
389 %*********************************************************
393 %*********************************************************
396 rnDecl (RuleD (IfaceRule rule_name vars fn args rhs src_loc))
397 = pushSrcLocRn src_loc $
398 lookupOccRn fn `thenRn` \ fn' ->
399 rnCoreBndrs vars $ \ vars' ->
400 mapFvRn rnCoreExpr args `thenRn` \ (args', fvs1) ->
401 rnCoreExpr rhs `thenRn` \ (rhs', fvs2) ->
402 returnRn (RuleD (IfaceRule rule_name vars' fn' args' rhs' src_loc),
403 (fvs1 `plusFV` fvs2) `addOneFV` fn')
405 rnDecl (RuleD (IfaceRuleOut fn rule))
406 -- This one is used for BuiltInRules
407 -- The rule itself is already done, but the thing
408 -- to attach it to is not.
409 = lookupOccRn fn `thenRn` \ fn' ->
410 returnRn (RuleD (IfaceRuleOut fn' rule), unitFV fn')
412 rnDecl (RuleD (HsRule rule_name tvs vars lhs rhs src_loc))
414 pushSrcLocRn src_loc $
416 bindTyVarsFV2Rn doc (map UserTyVar sig_tvs) $ \ sig_tvs' _ ->
417 bindLocalsFVRn doc (map get_var vars) $ \ ids ->
418 mapFvRn rn_var (vars `zip` ids) `thenRn` \ (vars', fv_vars) ->
420 rnExpr lhs `thenRn` \ (lhs', fv_lhs) ->
421 rnExpr rhs `thenRn` \ (rhs', fv_rhs) ->
422 checkRn (validRuleLhs ids lhs')
423 (badRuleLhsErr rule_name lhs') `thenRn_`
425 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
427 mapRn (addErrRn . badRuleVar rule_name) bad_vars `thenRn_`
428 returnRn (RuleD (HsRule rule_name sig_tvs' vars' lhs' rhs' src_loc),
429 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
431 doc = text "the transformation rule" <+> ptext rule_name
432 sig_tvs = extractRuleBndrsTyVars vars
434 get_var (RuleBndr v) = v
435 get_var (RuleBndrSig v _) = v
437 rn_var (RuleBndr v, id) = returnRn (RuleBndr id, emptyFVs)
438 rn_var (RuleBndrSig v t, id) = rnHsType doc t `thenRn` \ (t', fvs) ->
439 returnRn (RuleBndrSig id t', fvs)
443 %*********************************************************
445 \subsection{Support code for type/data declarations}
447 %*********************************************************
450 rnDerivs :: Maybe [RdrName] -> RnMS (Maybe [Name], FreeVars)
452 rnDerivs Nothing -- derivs not specified
453 = returnRn (Nothing, emptyFVs)
456 = mapRn do_one clss `thenRn` \ clss' ->
457 returnRn (Just clss', mkNameSet clss')
459 do_one cls = lookupOccRn cls `thenRn` \ clas_name ->
460 checkRn (getUnique clas_name `elem` derivableClassKeys)
461 (derivingNonStdClassErr clas_name) `thenRn_`
466 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
467 conDeclName (ConDecl n _ _ _ _ l) = (n,l)
469 rnConDecl :: RdrNameConDecl -> RnMS (RenamedConDecl, FreeVars)
470 rnConDecl (ConDecl name wkr tvs cxt details locn)
471 = pushSrcLocRn locn $
472 checkConName name `thenRn_`
473 lookupTopBndrRn name `thenRn` \ new_name ->
475 lookupSysBinder wkr `thenRn` \ new_wkr ->
476 -- See comments with ClassDecl
478 bindTyVarsFVRn doc tvs $ \ new_tyvars ->
479 rnContext doc cxt `thenRn` \ (new_context, cxt_fvs) ->
480 rnConDetails doc locn details `thenRn` \ (new_details, det_fvs) ->
481 returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn,
482 cxt_fvs `plusFV` det_fvs)
484 doc = text "the definition of data constructor" <+> quotes (ppr name)
486 rnConDetails doc locn (VanillaCon tys)
487 = mapFvRn (rnBangTy doc) tys `thenRn` \ (new_tys, fvs) ->
488 returnRn (VanillaCon new_tys, fvs)
490 rnConDetails doc locn (InfixCon ty1 ty2)
491 = rnBangTy doc ty1 `thenRn` \ (new_ty1, fvs1) ->
492 rnBangTy doc ty2 `thenRn` \ (new_ty2, fvs2) ->
493 returnRn (InfixCon new_ty1 new_ty2, fvs1 `plusFV` fvs2)
495 rnConDetails doc locn (RecCon fields)
496 = checkDupOrQualNames doc field_names `thenRn_`
497 mapFvRn (rnField doc) fields `thenRn` \ (new_fields, fvs) ->
498 returnRn (RecCon new_fields, fvs)
500 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
502 rnField doc (names, ty)
503 = mapRn lookupTopBndrRn names `thenRn` \ new_names ->
504 rnBangTy doc ty `thenRn` \ (new_ty, fvs) ->
505 returnRn ((new_names, new_ty), fvs)
507 rnBangTy doc (Banged ty)
508 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
509 returnRn (Banged new_ty, fvs)
511 rnBangTy doc (Unbanged ty)
512 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
513 returnRn (Unbanged new_ty, fvs)
515 rnBangTy doc (Unpacked ty)
516 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
517 returnRn (Unpacked new_ty, fvs)
519 -- This data decl will parse OK
521 -- treating "a" as the constructor.
522 -- It is really hard to make the parser spot this malformation.
523 -- So the renamer has to check that the constructor is legal
525 -- We can get an operator as the constructor, even in the prefix form:
526 -- data T = :% Int Int
527 -- from interface files, which always print in prefix form
530 = checkRn (isRdrDataCon name)
535 %*********************************************************
537 \subsection{Support code to rename types}
539 %*********************************************************
542 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
543 -- rnHsSigType is used for source-language type signatures,
544 -- which use *implicit* universal quantification.
545 rnHsSigType doc_str ty
546 = rnHsType (text "the type signature for" <+> doc_str) ty
548 ---------------------------------------
549 rnHsType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
551 rnHsType doc (HsForAllTy Nothing ctxt ty)
552 -- Implicit quantifiction in source code (no kinds on tyvars)
553 -- Given the signature C => T we universally quantify
554 -- over FV(T) \ {in-scope-tyvars}
555 = getLocalNameEnv `thenRn` \ name_env ->
557 mentioned_in_tau = extractHsTyRdrTyVars ty
558 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
559 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
560 forall_tyvars = filter (not . (`elemFM` name_env)) mentioned
562 rnForAll doc (map UserTyVar forall_tyvars) ctxt ty
564 rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
565 -- Explicit quantification.
566 -- Check that the forall'd tyvars are actually
567 -- mentioned in the type, and produce a warning if not
569 mentioned_in_tau = extractHsTyRdrTyVars tau
570 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
571 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
572 forall_tyvar_names = hsTyVarNames forall_tyvars
574 -- Explicitly quantified but not mentioned in ctxt or tau
575 warn_guys = filter (`notElem` mentioned) forall_tyvar_names
577 mapRn_ (forAllWarn doc tau) warn_guys `thenRn_`
578 rnForAll doc forall_tyvars ctxt tau
580 rnHsType doc (HsTyVar tyvar)
581 = lookupOccRn tyvar `thenRn` \ tyvar' ->
582 returnRn (HsTyVar tyvar', unitFV tyvar')
584 rnHsType doc (HsOpTy ty1 opname ty2)
585 = lookupOccRn opname `thenRn` \ name' ->
586 rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
587 rnHsType doc ty2 `thenRn` \ (ty2',fvs2) ->
588 returnRn (HsOpTy ty1' name' ty2', fvs1 `plusFV` fvs2 `addOneFV` name')
590 rnHsType doc (HsNumTy i)
591 | i == 1 = returnRn (HsNumTy i, emptyFVs)
592 | otherwise = failWithRn (HsNumTy i, emptyFVs)
593 (ptext SLIT("Only unit numeric type pattern is valid"))
595 rnHsType doc (HsFunTy ty1 ty2)
596 = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
597 -- Might find a for-all as the arg of a function type
598 rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
599 -- Or as the result. This happens when reading Prelude.hi
600 -- when we find return :: forall m. Monad m -> forall a. a -> m a
601 returnRn (HsFunTy ty1' ty2', fvs1 `plusFV` fvs2)
603 rnHsType doc (HsListTy ty)
604 = rnHsType doc ty `thenRn` \ (ty', fvs) ->
605 returnRn (HsListTy ty', fvs `addOneFV` listTyCon_name)
607 -- Unboxed tuples are allowed to have poly-typed arguments. These
608 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
609 rnHsType doc (HsTupleTy (HsTupCon _ boxity) tys)
610 -- Don't do lookupOccRn, because this is built-in syntax
611 -- so it doesn't need to be in scope
612 = mapFvRn (rnHsType doc) tys `thenRn` \ (tys', fvs) ->
613 returnRn (HsTupleTy (HsTupCon n' boxity) tys', fvs `addOneFV` n')
615 n' = tupleTyCon_name boxity (length tys)
618 rnHsType doc (HsAppTy ty1 ty2)
619 = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
620 rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
621 returnRn (HsAppTy ty1' ty2', fvs1 `plusFV` fvs2)
623 rnHsType doc (HsPredTy pred)
624 = rnPred doc pred `thenRn` \ (pred', fvs) ->
625 returnRn (HsPredTy pred', fvs)
627 rnHsType doc (HsUsgForAllTy uv_rdr ty)
628 = bindUVarRn doc uv_rdr $ \ uv_name ->
629 rnHsType doc ty `thenRn` \ (ty', fvs) ->
630 returnRn (HsUsgForAllTy uv_name ty',
633 rnHsType doc (HsUsgTy usg ty)
634 = newUsg usg `thenRn` \ (usg', usg_fvs) ->
635 rnHsType doc ty `thenRn` \ (ty', ty_fvs) ->
636 -- A for-all can occur inside a usage annotation
637 returnRn (HsUsgTy usg' ty',
638 usg_fvs `plusFV` ty_fvs)
640 newUsg usg = case usg of
641 HsUsOnce -> returnRn (HsUsOnce, emptyFVs)
642 HsUsMany -> returnRn (HsUsMany, emptyFVs)
643 HsUsVar uv_rdr -> lookupOccRn uv_rdr `thenRn` \ uv_name ->
644 returnRn (HsUsVar uv_name, emptyFVs)
646 rnHsTypes doc tys = mapFvRn (rnHsType doc) tys
650 -- We use lookupOcc here because this is interface file only stuff
651 -- and we need the workers...
652 rnHsTupCon (HsTupCon n boxity)
653 = lookupOccRn n `thenRn` \ n' ->
654 returnRn (HsTupCon n' boxity, unitFV n')
656 rnHsTupConWkr (HsTupCon n boxity)
657 -- Tuple construtors are for the *worker* of the tuple
658 -- Going direct saves needless messing about
659 = lookupOccRn (mkRdrNameWkr n) `thenRn` \ n' ->
660 returnRn (HsTupCon n' boxity, unitFV n')
664 rnForAll doc forall_tyvars ctxt ty
665 = bindTyVarsFVRn doc forall_tyvars $ \ new_tyvars ->
666 rnContext doc ctxt `thenRn` \ (new_ctxt, cxt_fvs) ->
667 rnHsType doc ty `thenRn` \ (new_ty, ty_fvs) ->
668 returnRn (mkHsForAllTy (Just new_tyvars) new_ctxt new_ty,
669 cxt_fvs `plusFV` ty_fvs)
673 rnContext :: SDoc -> RdrNameContext -> RnMS (RenamedContext, FreeVars)
675 = mapAndUnzipRn rn_pred ctxt `thenRn` \ (theta, fvs_s) ->
677 (_, dups) = removeDupsEq theta
678 -- We only have equality, not ordering
680 -- Check for duplicate assertions
681 -- If this isn't an error, then it ought to be:
682 mapRn (addWarnRn . dupClassAssertWarn theta) dups `thenRn_`
683 returnRn (theta, plusFVs fvs_s)
685 --Someone discovered that @CCallable@ and @CReturnable@
686 -- could be used in contexts such as:
687 -- foo :: CCallable a => a -> PrimIO Int
688 -- Doing this utterly wrecks the whole point of introducing these
689 -- classes so we specifically check that this isn't being done.
690 rn_pred pred = rnPred doc pred `thenRn` \ (pred', fvs)->
691 checkRn (not (bad_pred pred'))
692 (naughtyCCallContextErr pred') `thenRn_`
693 returnRn (pred', fvs)
695 bad_pred (HsPClass clas _) = getUnique clas `elem` cCallishClassKeys
696 bad_pred other = False
699 rnPred doc (HsPClass clas tys)
700 = lookupOccRn clas `thenRn` \ clas_name ->
701 rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
702 returnRn (HsPClass clas_name tys', fvs `addOneFV` clas_name)
704 rnPred doc (HsPIParam n ty)
705 = newIPName n `thenRn` \ name ->
706 rnHsType doc ty `thenRn` \ (ty', fvs) ->
707 returnRn (HsPIParam name ty', fvs)
711 rnFds :: SDoc -> [FunDep RdrName] -> RnMS ([FunDep Name], FreeVars)
714 = mapAndUnzipRn rn_fds fds `thenRn` \ (theta, fvs_s) ->
715 returnRn (theta, plusFVs fvs_s)
718 = rnHsTyVars doc tys1 `thenRn` \ (tys1', fvs1) ->
719 rnHsTyVars doc tys2 `thenRn` \ (tys2', fvs2) ->
720 returnRn ((tys1', tys2'), fvs1 `plusFV` fvs2)
722 rnHsTyVars doc tvs = mapFvRn (rnHsTyvar doc) tvs
724 = lookupOccRn tyvar `thenRn` \ tyvar' ->
725 returnRn (tyvar', unitFV tyvar')
728 %*********************************************************
732 %*********************************************************
735 rnIdInfo (HsStrictness str) = returnRn (HsStrictness str, emptyFVs)
737 rnIdInfo (HsWorker worker)
738 = lookupOccRn worker `thenRn` \ worker' ->
739 returnRn (HsWorker worker', unitFV worker')
741 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ (expr', fvs) ->
742 returnRn (HsUnfold inline expr', fvs)
743 rnIdInfo (HsArity arity) = returnRn (HsArity arity, emptyFVs)
744 rnIdInfo HsNoCafRefs = returnRn (HsNoCafRefs, emptyFVs)
745 rnIdInfo HsCprInfo = returnRn (HsCprInfo, emptyFVs)
749 @UfCore@ expressions.
752 rnCoreExpr (UfType ty)
753 = rnHsType (text "unfolding type") ty `thenRn` \ (ty', fvs) ->
754 returnRn (UfType ty', fvs)
757 = lookupOccRn v `thenRn` \ v' ->
758 returnRn (UfVar v', unitFV v')
761 = returnRn (UfLit l, emptyFVs)
763 rnCoreExpr (UfLitLit l ty)
764 = rnHsType (text "litlit") ty `thenRn` \ (ty', fvs) ->
765 returnRn (UfLitLit l ty', fvs)
767 rnCoreExpr (UfCCall cc ty)
768 = rnHsType (text "ccall") ty `thenRn` \ (ty', fvs) ->
769 returnRn (UfCCall cc ty', fvs)
771 rnCoreExpr (UfTuple con args)
772 = rnHsTupConWkr con `thenRn` \ (con', fvs1) ->
773 mapFvRn rnCoreExpr args `thenRn` \ (args', fvs2) ->
774 returnRn (UfTuple con' args', fvs1 `plusFV` fvs2)
776 rnCoreExpr (UfApp fun arg)
777 = rnCoreExpr fun `thenRn` \ (fun', fv1) ->
778 rnCoreExpr arg `thenRn` \ (arg', fv2) ->
779 returnRn (UfApp fun' arg', fv1 `plusFV` fv2)
781 rnCoreExpr (UfCase scrut bndr alts)
782 = rnCoreExpr scrut `thenRn` \ (scrut', fvs1) ->
783 bindCoreLocalFVRn bndr ( \ bndr' ->
784 mapFvRn rnCoreAlt alts `thenRn` \ (alts', fvs2) ->
785 returnRn (UfCase scrut' bndr' alts', fvs2)
786 ) `thenRn` \ (case', fvs3) ->
787 returnRn (case', fvs1 `plusFV` fvs3)
789 rnCoreExpr (UfNote note expr)
790 = rnNote note `thenRn` \ (note', fvs1) ->
791 rnCoreExpr expr `thenRn` \ (expr', fvs2) ->
792 returnRn (UfNote note' expr', fvs1 `plusFV` fvs2)
794 rnCoreExpr (UfLam bndr body)
795 = rnCoreBndr bndr $ \ bndr' ->
796 rnCoreExpr body `thenRn` \ (body', fvs) ->
797 returnRn (UfLam bndr' body', fvs)
799 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
800 = rnCoreExpr rhs `thenRn` \ (rhs', fvs1) ->
801 rnCoreBndr bndr ( \ bndr' ->
802 rnCoreExpr body `thenRn` \ (body', fvs2) ->
803 returnRn (UfLet (UfNonRec bndr' rhs') body', fvs2)
804 ) `thenRn` \ (result, fvs3) ->
805 returnRn (result, fvs1 `plusFV` fvs3)
807 rnCoreExpr (UfLet (UfRec pairs) body)
808 = rnCoreBndrs bndrs $ \ bndrs' ->
809 mapFvRn rnCoreExpr rhss `thenRn` \ (rhss', fvs1) ->
810 rnCoreExpr body `thenRn` \ (body', fvs2) ->
811 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body', fvs1 `plusFV` fvs2)
813 (bndrs, rhss) = unzip pairs
817 rnCoreBndr (UfValBinder name ty) thing_inside
818 = rnHsType doc ty `thenRn` \ (ty', fvs1) ->
819 bindCoreLocalFVRn name ( \ name' ->
820 thing_inside (UfValBinder name' ty')
821 ) `thenRn` \ (result, fvs2) ->
822 returnRn (result, fvs1 `plusFV` fvs2)
824 doc = text "unfolding id"
826 rnCoreBndr (UfTyBinder name kind) thing_inside
827 = bindCoreLocalFVRn name $ \ name' ->
828 thing_inside (UfTyBinder name' kind)
830 rnCoreBndrs [] thing_inside = thing_inside []
831 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
832 rnCoreBndrs bs $ \ names' ->
833 thing_inside (name':names')
837 rnCoreAlt (con, bndrs, rhs)
838 = rnUfCon con bndrs `thenRn` \ (con', fvs1) ->
839 bindCoreLocalsFVRn bndrs ( \ bndrs' ->
840 rnCoreExpr rhs `thenRn` \ (rhs', fvs2) ->
841 returnRn ((con', bndrs', rhs'), fvs2)
842 ) `thenRn` \ (result, fvs3) ->
843 returnRn (result, fvs1 `plusFV` fvs3)
846 = rnHsType (text "unfolding coerce") ty `thenRn` \ (ty', fvs) ->
847 returnRn (UfCoerce ty', fvs)
849 rnNote (UfSCC cc) = returnRn (UfSCC cc, emptyFVs)
850 rnNote UfInlineCall = returnRn (UfInlineCall, emptyFVs)
851 rnNote UfInlineMe = returnRn (UfInlineMe, emptyFVs)
855 = returnRn (UfDefault, emptyFVs)
857 rnUfCon (UfTupleAlt tup_con) bndrs
858 = rnHsTupCon tup_con `thenRn` \ (HsTupCon con' _, fvs) ->
859 returnRn (UfDataAlt con', fvs)
860 -- Makes the type checker a little easier
862 rnUfCon (UfDataAlt con) _
863 = lookupOccRn con `thenRn` \ con' ->
864 returnRn (UfDataAlt con', unitFV con')
866 rnUfCon (UfLitAlt lit) _
867 = returnRn (UfLitAlt lit, emptyFVs)
869 rnUfCon (UfLitLitAlt lit ty) _
870 = rnHsType (text "litlit") ty `thenRn` \ (ty', fvs) ->
871 returnRn (UfLitLitAlt lit ty', fvs)
874 %*********************************************************
876 \subsection{Rule shapes}
878 %*********************************************************
880 Check the shape of a transformation rule LHS. Currently
881 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
882 not one of the @forall@'d variables.
885 validRuleLhs foralls lhs
888 check (HsApp e1 e2) = check e1
889 check (HsVar v) | v `notElem` foralls = True
894 %*********************************************************
898 %*********************************************************
901 derivingNonStdClassErr clas
902 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
904 classTyVarNotInOpTyErr clas_tyvar sig
905 = hang (hsep [ptext SLIT("Class type variable"),
906 quotes (ppr clas_tyvar),
907 ptext SLIT("does not appear in method signature")])
911 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
913 forAllWarn doc ty tyvar
914 | not opt_WarnUnusedMatches = returnRn ()
916 = getModeRn `thenRn` \ mode ->
919 InterfaceMode -> returnRn () ; -- Don't warn of unused tyvars in interface files
920 -- unless DEBUG is on, in which case it is slightly
921 -- informative. They can arise from mkRhsTyLam,
922 #endif -- leading to (say) f :: forall a b. [b] -> [b]
926 sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
927 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
929 (ptext SLIT("In") <+> doc))
932 badRuleLhsErr name lhs
933 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
934 nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
936 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
939 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
940 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
941 ptext SLIT("does not appear on left hand side")]
943 badExtName :: ExtName -> Message
945 = sep [quotes (ppr ext_nm) <+> ptext SLIT("is not a valid C identifier")]
947 dupClassAssertWarn ctxt (assertion : dups)
948 = sep [hsep [ptext SLIT("Duplicate class assertion"),
949 quotes (ppr assertion),
950 ptext SLIT("in the context:")],
951 nest 4 (pprHsContext ctxt <+> ptext SLIT("..."))]
953 naughtyCCallContextErr (HsPClass clas _)
954 = sep [ptext SLIT("Can't use class") <+> quotes (ppr clas),
955 ptext SLIT("in a context")]