2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
7 module RnSource ( rnDecl, rnSourceDecls, rnHsType, rnHsSigType ) where
9 #include "HsVersions.h"
14 import HsTypes ( getTyVarName, 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, lookupBndrRn, lookupOccRn, getIPName,
25 lookupImplicitOccRn, lookupImplicitOccsRn,
26 bindLocalsRn, bindLocalRn, bindLocalsFVRn, bindUVarRn,
27 bindTyVarsFVRn, bindTyVarsFV2Rn, extendTyVarEnvFVRn,
28 bindCoreLocalFVRn, bindCoreLocalsFVRn,
29 checkDupOrQualNames, checkDupNames,
30 mkImportedGlobalName, mkImportedGlobalFromRdrName,
31 newDFunName, getDFunKey, newImplicitBinder,
32 FreeVars, emptyFVs, plusFV, plusFVs, unitFV,
37 import FunDeps ( oclose )
38 import Class ( FunDep )
40 import Name ( Name, OccName,
41 ExportFlag(..), Provenance(..),
42 nameOccName, NamedThing(..)
45 import OccName ( mkDefaultMethodOcc )
46 import BasicTypes ( TopLevelFlag(..) )
47 import FiniteMap ( elemFM )
48 import PrelInfo ( derivableClassKeys, cCallishClassKeys,
49 deRefStablePtr_RDR, makeStablePtr_RDR,
50 bindIO_RDR, returnIO_RDR
52 import Bag ( bagToList )
53 import List ( partition, nub )
55 import SrcLoc ( SrcLoc )
56 import CmdLineOpts ( opt_GlasgowExts, opt_WarnUnusedMatches ) -- Warn of unused for-all'd tyvars
57 import Unique ( Uniquable(..) )
58 import UniqFM ( lookupUFM )
59 import ErrUtils ( Message )
60 import CStrings ( isCLabelString )
61 import Maybes ( maybeToBool, catMaybes )
65 @rnDecl@ `renames' declarations.
66 It simultaneously performs dependency analysis and precedence parsing.
67 It also does the following error checks:
70 Checks that tyvars are used properly. This includes checking
71 for undefined tyvars, and tyvars in contexts that are ambiguous.
72 (Some of this checking has now been moved to module @TcMonoType@,
73 since we don't have functional dependency information at this point.)
75 Checks that all variable occurences are defined.
77 Checks the @(..)@ etc constraints in the export list.
81 %*********************************************************
83 \subsection{Value declarations}
85 %*********************************************************
88 rnSourceDecls :: [RdrNameHsDecl] -> RnMS ([RenamedHsDecl], FreeVars)
89 -- The decls get reversed, but that's ok
92 = go emptyFVs [] decls
94 -- Fixity and deprecations have been dealt with already; ignore them
95 go fvs ds' [] = returnRn (ds', fvs)
96 go fvs ds' (FixD _:ds) = go fvs ds' ds
97 go fvs ds' (DeprecD _:ds) = go fvs ds' ds
98 go fvs ds' (d:ds) = rnDecl d `thenRn` \(d', fvs') ->
99 go (fvs `plusFV` fvs') (d':ds') ds
103 %*********************************************************
105 \subsection{Value declarations}
107 %*********************************************************
110 -- rnDecl does all the work
111 rnDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
113 rnDecl (ValD binds) = rnTopBinds binds `thenRn` \ (new_binds, fvs) ->
114 returnRn (ValD new_binds, fvs)
117 rnDecl (SigD (IfaceSig name ty id_infos loc))
119 mkImportedGlobalFromRdrName name `thenRn` \ name' ->
120 rnHsType doc_str ty `thenRn` \ (ty',fvs1) ->
121 mapFvRn rnIdInfo id_infos `thenRn` \ (id_infos', fvs2) ->
122 returnRn (SigD (IfaceSig name' ty' id_infos' loc), fvs1 `plusFV` fvs2)
124 doc_str = text "the interface signature for" <+> quotes (ppr name)
127 %*********************************************************
129 \subsection{Type declarations}
131 %*********************************************************
133 @rnTyDecl@ uses the `global name function' to create a new type
134 declaration in which local names have been replaced by their original
135 names, reporting any unknown names.
137 Renaming type variables is a pain. Because they now contain uniques,
138 it is necessary to pass in an association list which maps a parsed
139 tyvar to its @Name@ representation.
140 In some cases (type signatures of values),
141 it is even necessary to go over the type first
142 in order to get the set of tyvars used by it, make an assoc list,
143 and then go over it again to rename the tyvars!
144 However, we can also do some scoping checks at the same time.
147 rnDecl (TyClD (TyData new_or_data context tycon tyvars condecls nconstrs derivings pragmas src_loc))
148 = pushSrcLocRn src_loc $
149 lookupBndrRn tycon `thenRn` \ tycon' ->
150 bindTyVarsFVRn data_doc tyvars $ \ tyvars' ->
151 rnContext data_doc context `thenRn` \ (context', cxt_fvs) ->
152 checkDupOrQualNames data_doc con_names `thenRn_`
153 mapFvRn rnConDecl condecls `thenRn` \ (condecls', con_fvs) ->
154 rnDerivs derivings `thenRn` \ (derivings', deriv_fvs) ->
155 ASSERT(isNoDataPragmas pragmas)
156 returnRn (TyClD (TyData new_or_data context' tycon' tyvars' condecls' nconstrs
157 derivings' noDataPragmas src_loc),
158 cxt_fvs `plusFV` con_fvs `plusFV` deriv_fvs)
160 data_doc = text "the data type declaration for" <+> quotes (ppr tycon)
161 con_names = map conDeclName condecls
163 rnDecl (TyClD (TySynonym name tyvars ty src_loc))
164 = pushSrcLocRn src_loc $
165 lookupBndrRn name `thenRn` \ name' ->
166 bindTyVarsFVRn syn_doc tyvars $ \ tyvars' ->
167 rnHsType syn_doc (unquantify ty) `thenRn` \ (ty', ty_fvs) ->
168 returnRn (TyClD (TySynonym name' tyvars' ty' src_loc), ty_fvs)
170 syn_doc = text "the declaration for type synonym" <+> quotes (ppr name)
172 -- For H98 we do *not* universally quantify on the RHS of a synonym
173 -- Silently discard context... but the tyvars in the rest won't be in scope
174 unquantify (HsForAllTy Nothing ctxt ty) | not opt_GlasgowExts = ty
177 rnDecl (TyClD (ClassDecl context cname tyvars fds sigs mbinds pragmas
178 tname dname dwname snames src_loc))
179 = pushSrcLocRn src_loc $
181 lookupBndrRn cname `thenRn` \ cname' ->
183 -- Deal with the implicit tycon and datacon name
184 -- They aren't in scope (because they aren't visible to the user)
185 -- and what we want to do is simply look them up in the cache;
186 -- we jolly well ought to get a 'hit' there!
187 -- So the 'Imported' part of this call is not relevant.
188 -- Unclean; but since these two are the only place this happens
189 -- I can't work up the energy to do it more beautifully
190 mkImportedGlobalFromRdrName tname `thenRn` \ tname' ->
191 mkImportedGlobalFromRdrName dname `thenRn` \ dname' ->
192 mkImportedGlobalFromRdrName dwname `thenRn` \ dwname' ->
193 mapRn mkImportedGlobalFromRdrName snames `thenRn` \ snames' ->
195 -- Tyvars scope over bindings and context
196 bindTyVarsFV2Rn cls_doc tyvars ( \ clas_tyvar_names tyvars' ->
198 -- Check the superclasses
199 rnContext cls_doc context `thenRn` \ (context', cxt_fvs) ->
201 -- Check the functional dependencies
202 rnFds cls_doc fds `thenRn` \ (fds', fds_fvs) ->
204 -- Check the signatures
206 -- First process the class op sigs, then the fixity sigs.
207 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
209 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenRn_`
210 mapFvRn (rn_op cname' clas_tyvar_names fds') op_sigs `thenRn` \ (sigs', sig_fvs) ->
212 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _ _) <- sigs' ]
214 renameSigs (okClsDclSig binders) non_op_sigs `thenRn` \ (non_ops', fix_fvs) ->
217 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenRn_`
219 `thenRn` \ (mbinds', meth_fvs) ->
221 -- Typechecker is responsible for checking that we only
222 -- give default-method bindings for things in this class.
223 -- The renamer *could* check this for class decls, but can't
224 -- for instance decls.
226 ASSERT(isNoClassPragmas pragmas)
227 returnRn (TyClD (ClassDecl context' cname' tyvars' fds' (non_ops' ++ sigs') mbinds'
228 NoClassPragmas tname' dname' dwname' snames' src_loc),
237 cls_doc = text "the declaration for class" <+> ppr cname
238 sig_doc = text "the signatures for class" <+> ppr cname
239 meth_doc = text "the default-methods for class" <+> ppr cname
241 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ _ locn <- sigs]
242 meth_rdr_names_w_locs = bagToList (collectMonoBinders mbinds)
243 meth_rdr_names = map fst meth_rdr_names_w_locs
245 rn_op clas clas_tyvars clas_fds sig@(ClassOpSig op dm_rdr_name explicit_dm ty locn)
246 = pushSrcLocRn locn $
247 lookupBndrRn op `thenRn` \ op_name ->
249 -- Check the signature
250 rnHsSigType (quotes (ppr op)) ty `thenRn` \ (new_ty, op_ty_fvs) ->
252 check_in_op_ty clas_tyvar =
253 checkRn (clas_tyvar `elemNameSet` oclose clas_fds op_ty_fvs)
254 (classTyVarNotInOpTyErr clas_tyvar sig)
256 mapRn_ check_in_op_ty clas_tyvars `thenRn_`
258 -- Make the default-method name
259 getModeRn `thenRn` \ mode ->
261 SourceMode -> -- Source class decl
262 newImplicitBinder (mkDefaultMethodOcc (rdrNameOcc op)) locn `thenRn` \ dm_name ->
263 returnRn (dm_name, op `elem` meth_rdr_names, emptyFVs)
266 -> -- Imported class that has a default method decl
267 -- See comments with tname, snames, above
268 lookupImplicitOccRn dm_rdr_name `thenRn` \ dm_name ->
269 returnRn (dm_name, explicit_dm, if explicit_dm then unitFV dm_name else emptyFVs)
270 -- An imported class decl for a class decl that had an explicit default
271 -- method, mentions, rather than defines,
272 -- the default method, so we must arrange to pull it in
273 ) `thenRn` \ (dm_name, final_explicit_dm, dm_fvs) ->
275 returnRn (ClassOpSig op_name dm_name final_explicit_dm new_ty locn, op_ty_fvs `plusFV` dm_fvs)
279 %*********************************************************
281 \subsection{Instance declarations}
283 %*********************************************************
286 rnDecl (InstD (InstDecl inst_ty mbinds uprags dfun_rdr_name src_loc))
287 = pushSrcLocRn src_loc $
288 rnHsSigType (text "an instance decl") inst_ty `thenRn` \ (inst_ty', inst_fvs) ->
290 inst_tyvars = case inst_ty' of
291 HsForAllTy (Just inst_tyvars) _ _ -> inst_tyvars
293 -- (Slightly strangely) the forall-d tyvars scope over
294 -- the method bindings too
297 -- Rename the bindings
298 -- NB meth_names can be qualified!
299 checkDupNames meth_doc meth_names `thenRn_`
300 extendTyVarEnvFVRn inst_tyvars (
302 ) `thenRn` \ (mbinds', meth_fvs) ->
304 binders = mkNameSet (map fst (bagToList (collectMonoBinders mbinds')))
306 -- Rename the prags and signatures.
307 -- Note that the type variables are not in scope here,
308 -- so that instance Eq a => Eq (T a) where
309 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
311 renameSigs (okInstDclSig binders) uprags `thenRn` \ (new_uprags, prag_fvs) ->
313 getModeRn `thenRn` \ mode ->
315 InterfaceMode -> lookupImplicitOccRn dfun_rdr_name `thenRn` \ dfun_name ->
316 returnRn (dfun_name, unitFV dfun_name)
317 SourceMode -> newDFunName (getDFunKey inst_ty') src_loc
318 `thenRn` \ dfun_name ->
319 returnRn (dfun_name, emptyFVs)
321 `thenRn` \ (dfun_name, dfun_fv) ->
323 -- The typechecker checks that all the bindings are for the right class.
324 returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags dfun_name src_loc),
325 inst_fvs `plusFV` meth_fvs `plusFV` prag_fvs `plusFV` dfun_fv)
327 meth_doc = text "the bindings in an instance declaration"
328 meth_names = bagToList (collectMonoBinders mbinds)
331 %*********************************************************
333 \subsection{Default declarations}
335 %*********************************************************
338 rnDecl (DefD (DefaultDecl tys src_loc))
339 = pushSrcLocRn src_loc $
340 rnHsTypes doc_str tys `thenRn` \ (tys', fvs) ->
341 returnRn (DefD (DefaultDecl tys' src_loc), fvs)
343 doc_str = text "a `default' declaration"
346 %*********************************************************
348 \subsection{Foreign declarations}
350 %*********************************************************
353 rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
354 = pushSrcLocRn src_loc $
355 lookupOccRn name `thenRn` \ name' ->
359 lookupImplicitOccsRn [makeStablePtr_RDR, deRefStablePtr_RDR,
360 bindIO_RDR, returnIO_RDR]
362 lookupImplicitOccsRn [bindIO_RDR, returnIO_RDR] `thenRn` \ fvs ->
363 returnRn (addOneFV fvs name')
364 extra_fvs other = returnRn emptyFVs
366 checkRn (ok_ext_nm ext_nm) (badExtName ext_nm) `thenRn_`
368 extra_fvs imp_exp `thenRn` \ fvs1 ->
370 rnHsSigType fo_decl_msg ty `thenRn` \ (ty', fvs2) ->
371 returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc),
374 fo_decl_msg = ptext SLIT("a foreign declaration")
375 isDyn = isDynamicExtName ext_nm
377 ok_ext_nm Dynamic = True
378 ok_ext_nm (ExtName nm (Just mb)) = isCLabelString nm && isCLabelString mb
379 ok_ext_nm (ExtName nm Nothing) = isCLabelString nm
382 %*********************************************************
386 %*********************************************************
389 rnDecl (RuleD (IfaceRule rule_name vars fn args rhs src_loc))
390 = pushSrcLocRn src_loc $
391 lookupOccRn fn `thenRn` \ fn' ->
392 rnCoreBndrs vars $ \ vars' ->
393 mapFvRn rnCoreExpr args `thenRn` \ (args', fvs1) ->
394 rnCoreExpr rhs `thenRn` \ (rhs', fvs2) ->
395 returnRn (RuleD (IfaceRule rule_name vars' fn' args' rhs' src_loc),
396 (fvs1 `plusFV` fvs2) `addOneFV` fn')
398 rnDecl (RuleD (IfaceRuleOut fn rule))
399 -- This one is used for BuiltInRules
400 -- The rule itself is already done, but the thing
401 -- to attach it to is not.
402 = lookupOccRn fn `thenRn` \ fn' ->
403 returnRn (RuleD (IfaceRuleOut fn' rule), unitFV fn')
405 rnDecl (RuleD (HsRule rule_name tvs vars lhs rhs src_loc))
407 pushSrcLocRn src_loc $
409 bindTyVarsFV2Rn doc (map UserTyVar sig_tvs) $ \ sig_tvs' _ ->
410 bindLocalsFVRn doc (map get_var vars) $ \ ids ->
411 mapFvRn rn_var (vars `zip` ids) `thenRn` \ (vars', fv_vars) ->
413 rnExpr lhs `thenRn` \ (lhs', fv_lhs) ->
414 rnExpr rhs `thenRn` \ (rhs', fv_rhs) ->
415 checkRn (validRuleLhs ids lhs')
416 (badRuleLhsErr rule_name lhs') `thenRn_`
418 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
420 mapRn (addErrRn . badRuleVar rule_name) bad_vars `thenRn_`
421 returnRn (RuleD (HsRule rule_name sig_tvs' vars' lhs' rhs' src_loc),
422 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
424 doc = text "the transformation rule" <+> ptext rule_name
425 sig_tvs = extractRuleBndrsTyVars vars
427 get_var (RuleBndr v) = v
428 get_var (RuleBndrSig v _) = v
430 rn_var (RuleBndr v, id) = returnRn (RuleBndr id, emptyFVs)
431 rn_var (RuleBndrSig v t, id) = rnHsType doc t `thenRn` \ (t', fvs) ->
432 returnRn (RuleBndrSig id t', fvs)
436 %*********************************************************
438 \subsection{Support code for type/data declarations}
440 %*********************************************************
443 rnDerivs :: Maybe [RdrName] -> RnMS (Maybe [Name], FreeVars)
445 rnDerivs Nothing -- derivs not specified
446 = returnRn (Nothing, emptyFVs)
449 = mapRn do_one clss `thenRn` \ clss' ->
450 returnRn (Just clss', mkNameSet clss')
452 do_one cls = lookupOccRn cls `thenRn` \ clas_name ->
453 checkRn (getUnique clas_name `elem` derivableClassKeys)
454 (derivingNonStdClassErr clas_name) `thenRn_`
459 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
460 conDeclName (ConDecl n _ _ _ _ l) = (n,l)
462 rnConDecl :: RdrNameConDecl -> RnMS (RenamedConDecl, FreeVars)
463 rnConDecl (ConDecl name wkr tvs cxt details locn)
464 = pushSrcLocRn locn $
465 checkConName name `thenRn_`
466 lookupBndrRn name `thenRn` \ new_name ->
468 mkImportedGlobalFromRdrName wkr `thenRn` \ new_wkr ->
469 -- See comments with ClassDecl
471 bindTyVarsFVRn doc tvs $ \ new_tyvars ->
472 rnContext doc cxt `thenRn` \ (new_context, cxt_fvs) ->
473 rnConDetails doc locn details `thenRn` \ (new_details, det_fvs) ->
474 returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn,
475 cxt_fvs `plusFV` det_fvs)
477 doc = text "the definition of data constructor" <+> quotes (ppr name)
479 rnConDetails doc locn (VanillaCon tys)
480 = mapFvRn (rnBangTy doc) tys `thenRn` \ (new_tys, fvs) ->
481 returnRn (VanillaCon new_tys, fvs)
483 rnConDetails doc locn (InfixCon ty1 ty2)
484 = rnBangTy doc ty1 `thenRn` \ (new_ty1, fvs1) ->
485 rnBangTy doc ty2 `thenRn` \ (new_ty2, fvs2) ->
486 returnRn (InfixCon new_ty1 new_ty2, fvs1 `plusFV` fvs2)
488 rnConDetails doc locn (NewCon ty mb_field)
489 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
490 rn_field mb_field `thenRn` \ new_mb_field ->
491 returnRn (NewCon new_ty new_mb_field, fvs)
493 rn_field Nothing = returnRn Nothing
495 lookupBndrRn f `thenRn` \ new_f ->
496 returnRn (Just new_f)
498 rnConDetails doc locn (RecCon fields)
499 = checkDupOrQualNames doc field_names `thenRn_`
500 mapFvRn (rnField doc) fields `thenRn` \ (new_fields, fvs) ->
501 returnRn (RecCon new_fields, fvs)
503 field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
505 rnField doc (names, ty)
506 = mapRn lookupBndrRn names `thenRn` \ new_names ->
507 rnBangTy doc ty `thenRn` \ (new_ty, fvs) ->
508 returnRn ((new_names, new_ty), fvs)
510 rnBangTy doc (Banged ty)
511 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
512 returnRn (Banged new_ty, fvs)
514 rnBangTy doc (Unbanged ty)
515 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
516 returnRn (Unbanged new_ty, fvs)
518 rnBangTy doc (Unpacked ty)
519 = rnHsType doc ty `thenRn` \ (new_ty, fvs) ->
520 returnRn (Unpacked new_ty, fvs)
522 -- This data decl will parse OK
524 -- treating "a" as the constructor.
525 -- It is really hard to make the parser spot this malformation.
526 -- So the renamer has to check that the constructor is legal
528 -- We can get an operator as the constructor, even in the prefix form:
529 -- data T = :% Int Int
530 -- from interface files, which always print in prefix form
533 = checkRn (isRdrDataCon name)
538 %*********************************************************
540 \subsection{Support code to rename types}
542 %*********************************************************
545 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
546 -- rnHsSigType is used for source-language type signatures,
547 -- which use *implicit* universal quantification.
548 rnHsSigType doc_str ty
549 = rnHsType (text "the type signature for" <+> doc_str) ty
551 ---------------------------------------
552 rnHsType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
554 rnHsType doc (HsForAllTy Nothing ctxt ty)
555 -- Implicit quantifiction in source code (no kinds on tyvars)
556 -- Given the signature C => T we universally quantify
557 -- over FV(T) \ {in-scope-tyvars}
558 = getLocalNameEnv `thenRn` \ name_env ->
560 mentioned_in_tau = extractHsTyRdrTyVars ty
561 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
562 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
563 forall_tyvars = filter (not . (`elemFM` name_env)) mentioned
565 rnForAll doc (map UserTyVar forall_tyvars) ctxt ty
567 rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
568 -- Explicit quantification.
569 -- Check that the forall'd tyvars are actually
570 -- mentioned in the type, and produce a warning if not
572 mentioned_in_tau = extractHsTyRdrTyVars tau
573 mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
574 mentioned = nub (mentioned_in_tau ++ mentioned_in_ctxt)
575 forall_tyvar_names = map getTyVarName forall_tyvars
577 -- Explicitly quantified but not mentioned in ctxt or tau
578 warn_guys = filter (`notElem` mentioned) forall_tyvar_names
580 mapRn_ (forAllWarn doc tau) warn_guys `thenRn_`
581 rnForAll doc forall_tyvars ctxt tau
583 rnHsType doc (HsTyVar tyvar)
584 = lookupOccRn tyvar `thenRn` \ tyvar' ->
585 returnRn (HsTyVar tyvar', unitFV tyvar')
587 rnHsType doc (HsFunTy ty1 ty2)
588 = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
589 -- Might find a for-all as the arg of a function type
590 rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
591 -- Or as the result. This happens when reading Prelude.hi
592 -- when we find return :: forall m. Monad m -> forall a. a -> m a
593 returnRn (HsFunTy ty1' ty2', fvs1 `plusFV` fvs2)
595 rnHsType doc (HsListTy ty)
596 = rnHsType doc ty `thenRn` \ (ty', fvs) ->
597 returnRn (HsListTy ty', fvs `addOneFV` listTyCon_name)
599 -- Unboxed tuples are allowed to have poly-typed arguments. These
600 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
601 rnHsType doc (HsTupleTy (HsTupCon _ boxity) tys)
602 -- Don't do lookupOccRn, because this is built-in syntax
603 -- so it doesn't need to be in scope
604 = mapFvRn (rnHsType doc) tys `thenRn` \ (tys', fvs) ->
605 returnRn (HsTupleTy (HsTupCon n' boxity) tys', fvs `addOneFV` n')
607 n' = tupleTyCon_name boxity (length tys)
610 rnHsType doc (HsAppTy ty1 ty2)
611 = rnHsType doc ty1 `thenRn` \ (ty1', fvs1) ->
612 rnHsType doc ty2 `thenRn` \ (ty2', fvs2) ->
613 returnRn (HsAppTy ty1' ty2', fvs1 `plusFV` fvs2)
615 rnHsType doc (HsPredTy pred)
616 = rnPred doc pred `thenRn` \ (pred', fvs) ->
617 returnRn (HsPredTy pred', fvs)
619 rnHsType doc (HsUsgForAllTy uv_rdr ty)
620 = bindUVarRn doc uv_rdr $ \ uv_name ->
621 rnHsType doc ty `thenRn` \ (ty', fvs) ->
622 returnRn (HsUsgForAllTy uv_name ty',
625 rnHsType doc (HsUsgTy usg ty)
626 = newUsg usg `thenRn` \ (usg', usg_fvs) ->
627 rnHsType doc ty `thenRn` \ (ty', ty_fvs) ->
628 -- A for-all can occur inside a usage annotation
629 returnRn (HsUsgTy usg' ty',
630 usg_fvs `plusFV` ty_fvs)
632 newUsg usg = case usg of
633 HsUsOnce -> returnRn (HsUsOnce, emptyFVs)
634 HsUsMany -> returnRn (HsUsMany, emptyFVs)
635 HsUsVar uv_rdr -> lookupOccRn uv_rdr `thenRn` \ uv_name ->
636 returnRn (HsUsVar uv_name, emptyFVs)
638 rnHsTypes doc tys = mapFvRn (rnHsType doc) tys
642 -- We use lookupOcc here because this is interface file only stuff
643 -- and we need the workers...
644 rnHsTupCon (HsTupCon n boxity)
645 = lookupOccRn n `thenRn` \ n' ->
646 returnRn (HsTupCon n' boxity, unitFV n')
648 rnHsTupConWkr (HsTupCon n boxity)
649 -- Tuple construtors are for the *worker* of the tuple
650 -- Going direct saves needless messing about
651 = lookupOccRn (mkRdrNameWkr n) `thenRn` \ n' ->
652 returnRn (HsTupCon n' boxity, unitFV n')
656 -- Check that each constraint mentions at least one of the forall'd type variables
657 -- Since the forall'd type variables are a subset of the free tyvars
658 -- of the tau-type part, this guarantees that every constraint mentions
659 -- at least one of the free tyvars in ty
660 checkConstraints doc forall_tyvars tau_vars ctxt ty
661 = mapRn (checkPred doc forall_tyvars ty) ctxt `thenRn` \ maybe_ctxt' ->
662 returnRn (catMaybes maybe_ctxt')
663 -- Remove problem ones, to avoid duplicate error message.
665 checkPred doc forall_tyvars ty p@(HsPClass clas tys)
666 | not_univ = failWithRn Nothing (univErr doc p ty)
667 | otherwise = returnRn (Just p)
669 ct_vars = extractHsTysRdrTyVars tys
670 not_univ = -- At least one of the tyvars in each constraint must
671 -- be universally quantified. This restriction isn't in Hugs
672 not (any (`elem` forall_tyvars) ct_vars)
673 checkPred doc forall_tyvars ty p@(HsPIParam _ _)
676 rnForAll doc forall_tyvars ctxt ty
677 = bindTyVarsFVRn doc forall_tyvars $ \ new_tyvars ->
678 rnContext doc ctxt `thenRn` \ (new_ctxt, cxt_fvs) ->
679 rnHsType doc ty `thenRn` \ (new_ty, ty_fvs) ->
680 returnRn (mkHsForAllTy (Just new_tyvars) new_ctxt new_ty,
681 cxt_fvs `plusFV` ty_fvs)
685 rnContext :: SDoc -> RdrNameContext -> RnMS (RenamedContext, FreeVars)
687 = mapAndUnzipRn rn_pred ctxt `thenRn` \ (theta, fvs_s) ->
689 (_, dups) = removeDupsEq theta
690 -- We only have equality, not ordering
692 -- Check for duplicate assertions
693 -- If this isn't an error, then it ought to be:
694 mapRn (addWarnRn . dupClassAssertWarn theta) dups `thenRn_`
695 returnRn (theta, plusFVs fvs_s)
697 --Someone discovered that @CCallable@ and @CReturnable@
698 -- could be used in contexts such as:
699 -- foo :: CCallable a => a -> PrimIO Int
700 -- Doing this utterly wrecks the whole point of introducing these
701 -- classes so we specifically check that this isn't being done.
702 rn_pred pred = rnPred doc pred `thenRn` \ (pred', fvs)->
703 checkRn (not (bad_pred pred'))
704 (naughtyCCallContextErr pred') `thenRn_`
705 returnRn (pred', fvs)
707 bad_pred (HsPClass clas _) = getUnique clas `elem` cCallishClassKeys
708 bad_pred other = False
711 rnPred doc (HsPClass clas tys)
712 = lookupOccRn clas `thenRn` \ clas_name ->
713 rnHsTypes doc tys `thenRn` \ (tys', fvs) ->
714 returnRn (HsPClass clas_name tys', fvs `addOneFV` clas_name)
716 rnPred doc (HsPIParam n ty)
717 = getIPName n `thenRn` \ name ->
718 rnHsType doc ty `thenRn` \ (ty', fvs) ->
719 returnRn (HsPIParam name ty', fvs)
723 rnFds :: SDoc -> [FunDep RdrName] -> RnMS ([FunDep Name], FreeVars)
726 = mapAndUnzipRn rn_fds fds `thenRn` \ (theta, fvs_s) ->
727 returnRn (theta, plusFVs fvs_s)
730 = rnHsTyVars doc tys1 `thenRn` \ (tys1', fvs1) ->
731 rnHsTyVars doc tys2 `thenRn` \ (tys2', fvs2) ->
732 returnRn ((tys1', tys2'), fvs1 `plusFV` fvs2)
734 rnHsTyVars doc tvs = mapFvRn (rnHsTyvar doc) tvs
736 = lookupOccRn tyvar `thenRn` \ tyvar' ->
737 returnRn (tyvar', unitFV tyvar')
740 %*********************************************************
744 %*********************************************************
747 rnIdInfo (HsStrictness str) = returnRn (HsStrictness str, emptyFVs)
749 rnIdInfo (HsWorker worker)
750 = lookupOccRn worker `thenRn` \ worker' ->
751 returnRn (HsWorker worker', unitFV worker')
753 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ (expr', fvs) ->
754 returnRn (HsUnfold inline expr', fvs)
755 rnIdInfo (HsArity arity) = returnRn (HsArity arity, emptyFVs)
756 rnIdInfo (HsUpdate update) = returnRn (HsUpdate update, emptyFVs)
757 rnIdInfo HsNoCafRefs = returnRn (HsNoCafRefs, emptyFVs)
758 rnIdInfo HsCprInfo = returnRn (HsCprInfo, emptyFVs)
762 @UfCore@ expressions.
765 rnCoreExpr (UfType ty)
766 = rnHsType (text "unfolding type") ty `thenRn` \ (ty', fvs) ->
767 returnRn (UfType ty', fvs)
770 = lookupOccRn v `thenRn` \ v' ->
771 returnRn (UfVar v', unitFV v')
774 = returnRn (UfLit l, emptyFVs)
776 rnCoreExpr (UfLitLit l ty)
777 = rnHsType (text "litlit") ty `thenRn` \ (ty', fvs) ->
778 returnRn (UfLitLit l ty', fvs)
780 rnCoreExpr (UfCCall cc ty)
781 = rnHsType (text "ccall") ty `thenRn` \ (ty', fvs) ->
782 returnRn (UfCCall cc ty', fvs)
784 rnCoreExpr (UfTuple con args)
785 = rnHsTupConWkr con `thenRn` \ (con', fvs1) ->
786 mapFvRn rnCoreExpr args `thenRn` \ (args', fvs2) ->
787 returnRn (UfTuple con' args', fvs1 `plusFV` fvs2)
789 rnCoreExpr (UfApp fun arg)
790 = rnCoreExpr fun `thenRn` \ (fun', fv1) ->
791 rnCoreExpr arg `thenRn` \ (arg', fv2) ->
792 returnRn (UfApp fun' arg', fv1 `plusFV` fv2)
794 rnCoreExpr (UfCase scrut bndr alts)
795 = rnCoreExpr scrut `thenRn` \ (scrut', fvs1) ->
796 bindCoreLocalFVRn bndr ( \ bndr' ->
797 mapFvRn rnCoreAlt alts `thenRn` \ (alts', fvs2) ->
798 returnRn (UfCase scrut' bndr' alts', fvs2)
799 ) `thenRn` \ (case', fvs3) ->
800 returnRn (case', fvs1 `plusFV` fvs3)
802 rnCoreExpr (UfNote note expr)
803 = rnNote note `thenRn` \ (note', fvs1) ->
804 rnCoreExpr expr `thenRn` \ (expr', fvs2) ->
805 returnRn (UfNote note' expr', fvs1 `plusFV` fvs2)
807 rnCoreExpr (UfLam bndr body)
808 = rnCoreBndr bndr $ \ bndr' ->
809 rnCoreExpr body `thenRn` \ (body', fvs) ->
810 returnRn (UfLam bndr' body', fvs)
812 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
813 = rnCoreExpr rhs `thenRn` \ (rhs', fvs1) ->
814 rnCoreBndr bndr ( \ bndr' ->
815 rnCoreExpr body `thenRn` \ (body', fvs2) ->
816 returnRn (UfLet (UfNonRec bndr' rhs') body', fvs2)
817 ) `thenRn` \ (result, fvs3) ->
818 returnRn (result, fvs1 `plusFV` fvs3)
820 rnCoreExpr (UfLet (UfRec pairs) body)
821 = rnCoreBndrs bndrs $ \ bndrs' ->
822 mapFvRn rnCoreExpr rhss `thenRn` \ (rhss', fvs1) ->
823 rnCoreExpr body `thenRn` \ (body', fvs2) ->
824 returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body', fvs1 `plusFV` fvs2)
826 (bndrs, rhss) = unzip pairs
830 rnCoreBndr (UfValBinder name ty) thing_inside
831 = rnHsType doc ty `thenRn` \ (ty', fvs1) ->
832 bindCoreLocalFVRn name ( \ name' ->
833 thing_inside (UfValBinder name' ty')
834 ) `thenRn` \ (result, fvs2) ->
835 returnRn (result, fvs1 `plusFV` fvs2)
837 doc = text "unfolding id"
839 rnCoreBndr (UfTyBinder name kind) thing_inside
840 = bindCoreLocalFVRn name $ \ name' ->
841 thing_inside (UfTyBinder name' kind)
843 rnCoreBndrs [] thing_inside = thing_inside []
844 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
845 rnCoreBndrs bs $ \ names' ->
846 thing_inside (name':names')
850 rnCoreAlt (con, bndrs, rhs)
851 = rnUfCon con bndrs `thenRn` \ (con', fvs1) ->
852 bindCoreLocalsFVRn bndrs ( \ bndrs' ->
853 rnCoreExpr rhs `thenRn` \ (rhs', fvs2) ->
854 returnRn ((con', bndrs', rhs'), fvs2)
855 ) `thenRn` \ (result, fvs3) ->
856 returnRn (result, fvs1 `plusFV` fvs3)
859 = rnHsType (text "unfolding coerce") ty `thenRn` \ (ty', fvs) ->
860 returnRn (UfCoerce ty', fvs)
862 rnNote (UfSCC cc) = returnRn (UfSCC cc, emptyFVs)
863 rnNote UfInlineCall = returnRn (UfInlineCall, emptyFVs)
864 rnNote UfInlineMe = returnRn (UfInlineMe, emptyFVs)
868 = returnRn (UfDefault, emptyFVs)
870 rnUfCon (UfTupleAlt tup_con) bndrs
871 = rnHsTupCon tup_con `thenRn` \ (HsTupCon con' _, fvs) ->
872 returnRn (UfDataAlt con', fvs)
873 -- Makes the type checker a little easier
875 rnUfCon (UfDataAlt con) _
876 = lookupOccRn con `thenRn` \ con' ->
877 returnRn (UfDataAlt con', unitFV con')
879 rnUfCon (UfLitAlt lit) _
880 = returnRn (UfLitAlt lit, emptyFVs)
882 rnUfCon (UfLitLitAlt lit ty) _
883 = rnHsType (text "litlit") ty `thenRn` \ (ty', fvs) ->
884 returnRn (UfLitLitAlt lit ty', fvs)
887 %*********************************************************
889 \subsection{Rule shapes}
891 %*********************************************************
893 Check the shape of a transformation rule LHS. Currently
894 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
895 not one of the @forall@'d variables.
898 validRuleLhs foralls lhs
901 check (HsApp e1 e2) = check e1
902 check (HsVar v) | v `notElem` foralls = True
907 %*********************************************************
911 %*********************************************************
914 derivingNonStdClassErr clas
915 = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
917 classTyVarNotInOpTyErr clas_tyvar sig
918 = hang (hsep [ptext SLIT("Class type variable"),
919 quotes (ppr clas_tyvar),
920 ptext SLIT("does not appear in method signature")])
924 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
926 forAllWarn doc ty tyvar
927 | not opt_WarnUnusedMatches = returnRn ()
929 = getModeRn `thenRn` \ mode ->
932 InterfaceMode -> returnRn () ; -- Don't warn of unused tyvars in interface files
933 -- unless DEBUG is on, in which case it is slightly
934 -- informative. They can arise from mkRhsTyLam,
935 #endif -- leading to (say) f :: forall a b. [b] -> [b]
939 sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
940 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
942 (ptext SLIT("In") <+> doc))
945 forAllErr doc ty tyvar
947 sep [ptext SLIT("The constrained type variable") <+> quotes (ppr tyvar),
948 nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
950 (ptext SLIT("In") <+> doc))
952 univErr doc constraint ty
953 = sep [ptext SLIT("All of the type variable(s) in the constraint")
954 <+> quotes (ppr constraint)
955 <+> ptext SLIT("are already in scope"),
956 nest 4 (ptext SLIT("At least one must be universally quantified here"))
959 (ptext SLIT("In") <+> doc)
961 badRuleLhsErr name lhs
962 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
963 nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
965 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
968 = sep [ptext SLIT("Rule") <+> ptext name <> colon,
969 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
970 ptext SLIT("does not appear on left hand side")]
972 badExtName :: ExtName -> Message
974 = sep [quotes (ppr ext_nm) <+> ptext SLIT("is not a valid C identifier")]
976 dupClassAssertWarn ctxt (assertion : dups)
977 = sep [hsep [ptext SLIT("Duplicate class assertion"),
978 quotes (ppr assertion),
979 ptext SLIT("in the context:")],
980 nest 4 (pprHsContext ctxt <+> ptext SLIT("..."))]
982 naughtyCCallContextErr (HsPClass clas _)
983 = sep [ptext SLIT("Can't use class") <+> quotes (ppr clas),
984 ptext SLIT("in a context")]