2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
13 #include "HsVersions.h"
15 import {-# SOURCE #-} RnExpr( rnLExpr )
18 import RdrName ( RdrName, isRdrDataCon, elemLocalRdrEnv,
19 globalRdrEnvElts, GlobalRdrElt(..), isLocalGRE )
20 import RdrHsSyn ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
22 import RnTypes ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
23 import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs, mkSigTvFn )
24 import RnEnv ( lookupLocalDataTcNames,
25 lookupLocatedTopBndrRn, lookupLocatedOccRn,
26 lookupOccRn, newLocalsRn,
27 bindLocatedLocalsFV, bindPatSigTyVarsFV,
28 bindTyVarsRn, extendTyVarEnvFVRn,
29 bindLocalNames, checkDupNames, mapFvRn
31 import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
34 import HscTypes ( FixityEnv, FixItem(..), Deprecations, Deprecs(..), plusDeprecs )
35 import Class ( FunDep )
36 import Name ( Name, nameOccName )
39 import OccName ( occEnvElts )
41 import SrcLoc ( Located(..), unLoc, noLoc )
42 import DynFlags ( DynFlag(..) )
43 import Maybes ( seqMaybe )
44 import Maybe ( isNothing )
45 import Monad ( liftM, when )
46 import BasicTypes ( Boxity(..) )
49 @rnSourceDecl@ `renames' declarations.
50 It simultaneously performs dependency analysis and precedence parsing.
51 It also does the following error checks:
54 Checks that tyvars are used properly. This includes checking
55 for undefined tyvars, and tyvars in contexts that are ambiguous.
56 (Some of this checking has now been moved to module @TcMonoType@,
57 since we don't have functional dependency information at this point.)
59 Checks that all variable occurences are defined.
61 Checks the @(..)@ etc constraints in the export list.
66 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
68 rnSrcDecls (HsGroup { hs_valds = val_decls,
69 hs_tyclds = tycl_decls,
70 hs_instds = inst_decls,
71 hs_derivds = deriv_decls,
73 hs_depds = deprec_decls,
74 hs_fords = foreign_decls,
75 hs_defds = default_decls,
76 hs_ruleds = rule_decls,
79 = do { -- Deal with deprecations (returns only the extra deprecations)
80 deprecs <- rnSrcDeprecDecls deprec_decls ;
81 updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
84 -- Deal with top-level fixity decls
85 -- (returns the total new fixity env)
86 rn_fix_decls <- rnSrcFixityDecls fix_decls ;
87 fix_env <- rnSrcFixityDeclsEnv rn_fix_decls ;
88 updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
91 -- Rename other declarations
92 traceRn (text "Start rnmono") ;
93 (rn_val_decls, bind_dus) <- rnTopBinds val_decls ;
94 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
96 -- You might think that we could build proper def/use information
97 -- for type and class declarations, but they can be involved
98 -- in mutual recursion across modules, and we only do the SCC
99 -- analysis for them in the type checker.
100 -- So we content ourselves with gathering uses only; that
101 -- means we'll only report a declaration as unused if it isn't
102 -- mentioned at all. Ah well.
103 traceRn (text "Start rnTyClDecls") ;
104 (rn_tycl_decls, src_fvs1) <- rnList rnTyClDecl tycl_decls ;
105 (rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ;
106 (rn_rule_decls, src_fvs3) <- rnList rnHsRuleDecl rule_decls ;
107 (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
108 (rn_default_decls, src_fvs5) <- rnList rnDefaultDecl default_decls ;
109 (rn_deriv_decls, src_fvs6) <- rnList rnSrcDerivDecl deriv_decls ;
111 -- Haddock docs; no free vars
112 rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
115 rn_group = HsGroup { hs_valds = rn_val_decls,
116 hs_tyclds = rn_tycl_decls,
117 hs_instds = rn_inst_decls,
118 hs_derivds = rn_deriv_decls,
119 hs_fixds = rn_fix_decls,
121 hs_fords = rn_foreign_decls,
122 hs_defds = rn_default_decls,
123 hs_ruleds = rn_rule_decls,
124 hs_docs = rn_docs } ;
126 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs6, src_fvs3,
127 src_fvs4, src_fvs5] ;
128 src_dus = bind_dus `plusDU` usesOnly other_fvs
129 -- Note: src_dus will contain *uses* for locally-defined types
130 -- and classes, but no *defs* for them. (Because rnTyClDecl
131 -- returns only the uses.) This is a little
132 -- surprising but it doesn't actually matter at all.
135 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
136 traceRn (text "finish Dus" <+> ppr src_dus ) ;
137 tcg_env <- getGblEnv ;
138 return (tcg_env `addTcgDUs` src_dus, rn_group)
141 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
142 -- Used for external core
143 rnTyClDecls tycl_decls = do (decls', fvs) <- rnList rnTyClDecl tycl_decls
146 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
147 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
149 rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
150 rnList f xs = mapFvRn (wrapLocFstM f) xs
154 %*********************************************************
158 %*********************************************************
161 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
162 rnDocDecl (DocCommentNext doc) = do
163 rn_doc <- rnHsDoc doc
164 return (DocCommentNext rn_doc)
165 rnDocDecl (DocCommentPrev doc) = do
166 rn_doc <- rnHsDoc doc
167 return (DocCommentPrev rn_doc)
168 rnDocDecl (DocCommentNamed str doc) = do
169 rn_doc <- rnHsDoc doc
170 return (DocCommentNamed str rn_doc)
171 rnDocDecl (DocGroup lev doc) = do
172 rn_doc <- rnHsDoc doc
173 return (DocGroup lev rn_doc)
177 %*********************************************************
179 Source-code fixity declarations
181 %*********************************************************
184 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
185 rnSrcFixityDecls fix_decls
186 = do fix_decls <- mapM rnFixityDecl fix_decls
187 return (concat fix_decls)
189 rnFixityDecl :: LFixitySig RdrName -> RnM [LFixitySig Name]
190 rnFixityDecl (L loc (FixitySig (L nameLoc rdr_name) fixity))
191 = setSrcSpan nameLoc $
192 -- GHC extension: look up both the tycon and data con
193 -- for con-like things
194 -- If neither are in scope, report an error; otherwise
195 -- add both to the fixity env
196 do names <- lookupLocalDataTcNames rdr_name
197 return [ L loc (FixitySig (L nameLoc name) fixity)
200 rnSrcFixityDeclsEnv :: [LFixitySig Name] -> RnM FixityEnv
201 rnSrcFixityDeclsEnv fix_decls
202 = getGblEnv `thenM` \ gbl_env ->
203 foldlM rnFixityDeclEnv (tcg_fix_env gbl_env)
204 fix_decls `thenM` \ fix_env ->
205 traceRn (text "fixity env" <+> pprFixEnv fix_env) `thenM_`
208 rnFixityDeclEnv :: FixityEnv -> LFixitySig Name -> RnM FixityEnv
209 rnFixityDeclEnv fix_env (L loc (FixitySig (L nameLoc name) fixity))
210 = case lookupNameEnv fix_env name of
211 Just (FixItem _ _ loc')
212 -> do addLocErr (L nameLoc name) (dupFixityDecl loc')
215 -> return (extendNameEnv fix_env name fix_item)
216 where fix_item = FixItem (nameOccName name) fixity nameLoc
218 pprFixEnv :: FixityEnv -> SDoc
220 = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
223 dupFixityDecl loc rdr_name
224 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
225 ptext SLIT("also at ") <+> ppr loc
230 %*********************************************************
232 Source-code deprecations declarations
234 %*********************************************************
236 For deprecations, all we do is check that the names are in scope.
237 It's only imported deprecations, dealt with in RnIfaces, that we
238 gather them together.
241 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
245 rnSrcDeprecDecls decls
246 = mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
247 returnM (DeprecSome (mkNameEnv (concat pairs_s)))
249 rn_deprec (Deprecation rdr_name txt)
250 = lookupLocalDataTcNames rdr_name `thenM` \ names ->
251 returnM [(name, (nameOccName name, txt)) | name <- names]
254 %*********************************************************
256 \subsection{Source code declarations}
258 %*********************************************************
261 rnDefaultDecl (DefaultDecl tys)
262 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
263 returnM (DefaultDecl tys', fvs)
265 doc_str = text "In a `default' declaration"
268 %*********************************************************
270 \subsection{Foreign declarations}
272 %*********************************************************
275 rnHsForeignDecl (ForeignImport name ty spec)
276 = lookupLocatedTopBndrRn name `thenM` \ name' ->
277 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
278 returnM (ForeignImport name' ty' spec, fvs)
280 rnHsForeignDecl (ForeignExport name ty spec)
281 = lookupLocatedOccRn name `thenM` \ name' ->
282 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
283 returnM (ForeignExport name' ty' spec, fvs )
284 -- NB: a foreign export is an *occurrence site* for name, so
285 -- we add it to the free-variable list. It might, for example,
286 -- be imported from another module
288 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
292 %*********************************************************
294 \subsection{Instance declarations}
296 %*********************************************************
299 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
300 -- Used for both source and interface file decls
301 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
303 -- Rename the associated types
304 -- The typechecker (not the renamer) checks that all
305 -- the declarations are for the right class
307 at_doc = text "In the associated types of an instance declaration"
308 at_names = map (head . tyClDeclNames . unLoc) ats
310 checkDupNames at_doc at_names `thenM_`
311 rnATInsts ats `thenM` \ (ats', at_fvs) ->
313 -- Rename the bindings
314 -- The typechecker (not the renamer) checks that all
315 -- the bindings are for the right class
317 meth_doc = text "In the bindings in an instance declaration"
318 meth_names = collectHsBindLocatedBinders mbinds
319 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
321 checkDupNames meth_doc meth_names `thenM_`
322 extendTyVarEnvForMethodBinds inst_tyvars (
323 -- (Slightly strangely) the forall-d tyvars scope over
324 -- the method bindings too
325 rnMethodBinds cls (\n->[]) -- No scoped tyvars
327 ) `thenM` \ (mbinds', meth_fvs) ->
328 -- Rename the prags and signatures.
329 -- Note that the type variables are not in scope here,
330 -- so that instance Eq a => Eq (T a) where
331 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
334 -- But the (unqualified) method names are in scope
336 binders = collectHsBindBinders mbinds'
337 ok_sig = okInstDclSig (mkNameSet binders)
339 bindLocalNames binders (renameSigs ok_sig uprags) `thenM` \ uprags' ->
341 returnM (InstDecl inst_ty' mbinds' uprags' ats',
342 meth_fvs `plusFV` at_fvs
343 `plusFV` hsSigsFVs uprags'
344 `plusFV` extractHsTyNames inst_ty')
345 -- We return the renamed associated data type declarations so
346 -- that they can be entered into the list of type declarations
347 -- for the binding group, but we also keep a copy in the instance.
348 -- The latter is needed for well-formedness checks in the type
349 -- checker (eg, to ensure that all ATs of the instance actually
350 -- receive a declaration).
351 -- NB: Even the copies in the instance declaration carry copies of
352 -- the instance context after renaming. This is a bit
353 -- strange, but should not matter (and it would be more work
354 -- to remove the context).
357 Renaming of the associated types in instances.
360 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
361 rnATInsts atDecls = rnList rnATInst atDecls
363 rnATInst tydecl@TyData {} = rnTyClDecl tydecl
364 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
366 pprPanic "RnSource.rnATInsts: invalid AT instance"
367 (ppr (tcdName tydecl))
370 For the method bindings in class and instance decls, we extend the
371 type variable environment iff -fglasgow-exts
374 extendTyVarEnvForMethodBinds tyvars thing_inside
375 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
376 if opt_GlasgowExts then
377 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
382 %*********************************************************
384 \subsection{Stand-alone deriving declarations}
386 %*********************************************************
389 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
390 rnSrcDerivDecl (DerivDecl ty)
391 = do ty' <- rnLHsType (text "a deriving decl") ty
392 let fvs = extractHsTyNames ty'
393 return (DerivDecl ty', fvs)
396 %*********************************************************
400 %*********************************************************
403 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
404 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
406 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
407 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
409 rnLExpr lhs `thenM` \ (lhs', fv_lhs') ->
410 rnLExpr rhs `thenM` \ (rhs', fv_rhs') ->
412 checkValidRule rule_name ids lhs' fv_lhs' `thenM_`
414 returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
415 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
417 doc = text "In the transformation rule" <+> ftext rule_name
419 get_var (RuleBndr v) = v
420 get_var (RuleBndrSig v _) = v
422 rn_var (RuleBndr (L loc v), id)
423 = returnM (RuleBndr (L loc id), emptyFVs)
424 rn_var (RuleBndrSig (L loc v) t, id)
425 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
426 returnM (RuleBndrSig (L loc id) t', fvs)
429 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
430 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
431 ptext SLIT("does not appear on left hand side")]
434 Note [Rule LHS validity checking]
435 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
436 Check the shape of a transformation rule LHS. Currently we only allow
437 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
438 @forall@'d variables.
440 We used restrict the form of the 'ei' to prevent you writing rules
441 with LHSs with a complicated desugaring (and hence unlikely to match);
442 (e.g. a case expression is not allowed: too elaborate.)
444 But there are legitimate non-trivial args ei, like sections and
445 lambdas. So it seems simmpler not to check at all, and that is why
446 check_e is commented out.
449 checkValidRule rule_name ids lhs' fv_lhs'
450 = do { -- Check for the form of the LHS
451 case (validRuleLhs ids lhs') of
453 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
455 -- Check that LHS vars are all bound
456 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
457 ; mappM (addErr . badRuleVar rule_name) bad_vars }
459 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
461 -- Just e => Not ok, and e is the offending expression
462 validRuleLhs foralls lhs
465 checkl (L loc e) = check e
467 check (OpApp e1 op _ e2) = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
468 check (HsApp e1 e2) = checkl e1 `seqMaybe` checkl_e e2
469 check (HsVar v) | v `notElem` foralls = Nothing
470 check other = Just other -- Failure
473 checkl_e (L loc e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
475 {- Commented out; see Note [Rule LHS validity checking] above
476 check_e (HsVar v) = Nothing
477 check_e (HsPar e) = checkl_e e
478 check_e (HsLit e) = Nothing
479 check_e (HsOverLit e) = Nothing
481 check_e (OpApp e1 op _ e2) = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
482 check_e (HsApp e1 e2) = checkl_e e1 `seqMaybe` checkl_e e2
483 check_e (NegApp e _) = checkl_e e
484 check_e (ExplicitList _ es) = checkl_es es
485 check_e (ExplicitTuple es _) = checkl_es es
486 check_e other = Just other -- Fails
488 checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
491 badRuleLhsErr name lhs bad_e
492 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
493 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
494 ptext SLIT("in left-hand side:") <+> ppr lhs])]
496 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
500 %*********************************************************
502 \subsection{Type, class and iface sig declarations}
504 %*********************************************************
506 @rnTyDecl@ uses the `global name function' to create a new type
507 declaration in which local names have been replaced by their original
508 names, reporting any unknown names.
510 Renaming type variables is a pain. Because they now contain uniques,
511 it is necessary to pass in an association list which maps a parsed
512 tyvar to its @Name@ representation.
513 In some cases (type signatures of values),
514 it is even necessary to go over the type first
515 in order to get the set of tyvars used by it, make an assoc list,
516 and then go over it again to rename the tyvars!
517 However, we can also do some scoping checks at the same time.
520 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
521 = lookupLocatedTopBndrRn name `thenM` \ name' ->
522 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
525 -- all flavours of type family declarations ("type family", "newtype fanily",
526 -- and "data family")
527 rnTyClDecl (tydecl@TyFamily {}) =
528 rnFamily tydecl bindTyVarsRn
530 -- "data", "newtype", "data instance, and "newtype instance" declarations
531 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
532 tcdLName = tycon, tcdTyVars = tyvars,
533 tcdTyPats = typatsMaybe, tcdCons = condecls,
534 tcdKindSig = sig, tcdDerivs = derivs})
535 | is_vanilla -- Normal Haskell data type decl
536 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
537 -- data type is syntactically illegal
538 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
539 do { tycon' <- if isFamInstDecl tydecl
540 then lookupLocatedOccRn tycon -- may be imported family
541 else lookupLocatedTopBndrRn tycon
542 ; context' <- rnContext data_doc context
543 ; typats' <- rnTyPats data_doc typatsMaybe
544 ; (derivs', deriv_fvs) <- rn_derivs derivs
545 ; checkDupNames data_doc con_names
546 ; condecls' <- rnConDecls (unLoc tycon') condecls
547 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
548 tcdLName = tycon', tcdTyVars = tyvars',
549 tcdTyPats = typats', tcdKindSig = Nothing,
550 tcdCons = condecls', tcdDerivs = derivs'},
551 delFVs (map hsLTyVarName tyvars') $
552 extractHsCtxtTyNames context' `plusFV`
553 plusFVs (map conDeclFVs condecls') `plusFV`
555 (if isFamInstDecl tydecl
556 then unitFV (unLoc tycon') -- type instance => use
561 = ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
562 do { tycon' <- if isFamInstDecl tydecl
563 then lookupLocatedOccRn tycon -- may be imported family
564 else lookupLocatedTopBndrRn tycon
565 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
566 ; tyvars' <- bindTyVarsRn data_doc tyvars
567 (\ tyvars' -> return tyvars')
568 -- For GADTs, the type variables in the declaration
569 -- do not scope over the constructor signatures
570 -- data T a where { T1 :: forall b. b-> b }
571 ; (derivs', deriv_fvs) <- rn_derivs derivs
572 ; checkDupNames data_doc con_names
573 ; condecls' <- rnConDecls (unLoc tycon') condecls
574 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
575 tcdLName = tycon', tcdTyVars = tyvars',
576 tcdTyPats = Nothing, tcdKindSig = sig,
577 tcdCons = condecls', tcdDerivs = derivs'},
578 plusFVs (map conDeclFVs condecls') `plusFV`
580 (if isFamInstDecl tydecl
581 then unitFV (unLoc tycon') -- type instance => use
585 is_vanilla = case condecls of -- Yuk
587 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
591 none (Just []) = True
594 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
595 con_names = map con_names_helper condecls
597 con_names_helper (L _ c) = con_name c
599 rn_derivs Nothing = returnM (Nothing, emptyFVs)
600 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
601 returnM (Just ds', extractHsTyNames_s ds')
603 -- "type" and "type instance" declarations
604 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
605 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
606 = bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
607 do { name' <- if isFamInstDecl tydecl
608 then lookupLocatedOccRn name -- may be imported family
609 else lookupLocatedTopBndrRn name
610 ; typats' <- rnTyPats syn_doc typatsMaybe
611 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
612 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
613 tcdTyPats = typats', tcdSynRhs = ty'},
614 delFVs (map hsLTyVarName tyvars') $
616 (if isFamInstDecl tydecl
617 then unitFV (unLoc name') -- type instance => use
621 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
623 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
624 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
625 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
626 = do { cname' <- lookupLocatedTopBndrRn cname
628 -- Tyvars scope over superclass context and method signatures
629 ; (tyvars', context', fds', ats', ats_fvs, sigs')
630 <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
631 { context' <- rnContext cls_doc context
632 ; fds' <- rnFds cls_doc fds
633 ; (ats', ats_fvs) <- rnATs ats
634 ; sigs' <- renameSigs okClsDclSig sigs
635 ; return (tyvars', context', fds', ats', ats_fvs, sigs') }
637 -- Check for duplicates among the associated types
638 ; let at_rdr_names_w_locs = [tcdLName ty | L _ ty <- ats]
639 ; checkDupNames at_doc at_rdr_names_w_locs
641 -- Check the signatures
642 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
643 ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
644 ; checkDupNames sig_doc sig_rdr_names_w_locs
645 -- Typechecker is responsible for checking that we only
646 -- give default-method bindings for things in this class.
647 -- The renamer *could* check this for class decls, but can't
648 -- for instance decls.
650 -- The newLocals call is tiresome: given a generic class decl
653 -- op {| x+y |} (Inl a) = ...
654 -- op {| x+y |} (Inr b) = ...
655 -- op {| a*b |} (a*b) = ...
656 -- we want to name both "x" tyvars with the same unique, so that they are
657 -- easy to group together in the typechecker.
658 ; (mbinds', meth_fvs)
659 <- extendTyVarEnvForMethodBinds tyvars' $ do
660 { name_env <- getLocalRdrEnv
661 ; let meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
662 gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
663 not (unLoc tv `elemLocalRdrEnv` name_env) ]
664 ; checkDupNames meth_doc meth_rdr_names_w_locs
665 ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
666 ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
669 ; docs' <- mapM (wrapLocM rnDocDecl) docs
671 ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
672 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
673 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
675 delFVs (map hsLTyVarName tyvars') $
676 extractHsCtxtTyNames context' `plusFV`
677 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
678 hsSigsFVs sigs' `plusFV`
682 meth_doc = text "In the default-methods for class" <+> ppr cname
683 cls_doc = text "In the declaration for class" <+> ppr cname
684 sig_doc = text "In the signatures for class" <+> ppr cname
685 at_doc = text "In the associated types for class" <+> ppr cname
687 badGadtStupidTheta tycon
688 = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
689 ptext SLIT("(You can put a context on each contructor, though.)")]
692 %*********************************************************
694 \subsection{Support code for type/data declarations}
696 %*********************************************************
699 -- Although, we are processing type patterns here, all type variables will
700 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
701 -- type declaration to which these patterns belong)
703 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
704 rnTyPats _ Nothing = return Nothing
705 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
707 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
708 rnConDecls tycon condecls
709 = mappM (wrapLocM rnConDecl) condecls
711 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
712 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
713 = do { addLocM checkConName name
715 ; new_name <- lookupLocatedTopBndrRn name
716 ; name_env <- getLocalRdrEnv
718 -- For H98 syntax, the tvs are the existential ones
719 -- For GADT syntax, the tvs are all the quantified tyvars
720 -- Hence the 'filter' in the ResTyH98 case only
721 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
722 arg_tys = hsConArgs details
723 implicit_tvs = case res_ty of
724 ResTyH98 -> filter not_in_scope $
726 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
729 Implicit -> userHsTyVarBndrs implicit_tvs
731 ; mb_doc' <- rnMbLHsDoc mb_doc
733 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
734 { new_context <- rnContext doc cxt
735 ; new_details <- rnConDetails doc details
736 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
737 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
739 doc = text "In the definition of data constructor" <+> quotes (ppr name)
740 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
742 rnConResult _ details ResTyH98 = return (details, ResTyH98)
744 rnConResult doc details (ResTyGADT ty) = do
745 ty' <- rnHsSigType doc ty
746 let (arg_tys, res_ty) = splitHsFunType ty'
747 -- We can split it up, now the renamer has dealt with fixities
749 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
750 RecCon fields -> return (details, ResTyGADT ty')
751 InfixCon {} -> panic "rnConResult"
753 rnConDetails doc (PrefixCon tys)
754 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
755 returnM (PrefixCon new_tys)
757 rnConDetails doc (InfixCon ty1 ty2)
758 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
759 rnLHsType doc ty2 `thenM` \ new_ty2 ->
760 returnM (InfixCon new_ty1 new_ty2)
762 rnConDetails doc (RecCon fields)
763 = checkDupNames doc field_names `thenM_`
764 mappM (rnField doc) fields `thenM` \ new_fields ->
765 returnM (RecCon new_fields)
767 field_names = [ name | HsRecField name _ _ <- fields ]
769 -- Document comments are renamed to Nothing here
770 rnField doc (HsRecField name ty haddock_doc)
771 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
772 rnLHsType doc ty `thenM` \ new_ty ->
773 rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
774 returnM (HsRecField new_name new_ty new_haddock_doc)
776 -- Rename family declarations
778 -- * This function is parametrised by the routine handling the index
779 -- variables. On the toplevel, these are defining occurences, whereas they
780 -- are usage occurences for associated types.
782 rnFamily :: TyClDecl RdrName
783 -> (SDoc -> [LHsTyVarBndr RdrName] ->
784 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
785 RnM (TyClDecl Name, FreeVars))
786 -> RnM (TyClDecl Name, FreeVars)
788 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
789 tcdLName = tycon, tcdTyVars = tyvars})
791 do { checkM (isDataFlavour flavour -- for synonyms,
792 || not (null tyvars)) $ addErr needOneIdx -- #indexes >= 1
793 ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
794 ; tycon' <- lookupLocatedTopBndrRn tycon
795 ; returnM (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
796 tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
800 isDataFlavour (DataFamily _) = True
801 isDataFlavour _ = False
803 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
804 needOneIdx = text "Type family declarations requires at least one type index"
806 -- Rename associated type declarations (in classes)
808 -- * This can be family declarations and (default) type instances
810 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
811 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
813 rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
814 rn_at (tydecl@TySynonym {}) =
816 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
818 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
820 lookupIdxVars _ tyvars cont =
821 do { checkForDups tyvars;
822 ; tyvars' <- mappM lookupIdxVar tyvars
825 -- Type index variables must be class parameters, which are the only
826 -- type variables in scope at this point.
827 lookupIdxVar (L l tyvar) =
829 name' <- lookupOccRn (hsTyVarName tyvar)
830 return $ L l (replaceTyVarName tyvar name')
832 -- Type variable may only occur once.
834 checkForDups [] = return ()
835 checkForDups (L loc tv:ltvs) =
836 do { setSrcSpan loc $
837 when (hsTyVarName tv `ltvElem` ltvs) $
838 addErr (repeatedTyVar tv)
842 rdrName `ltvElem` [] = False
843 rdrName `ltvElem` (L _ tv:ltvs)
844 | rdrName == hsTyVarName tv = True
845 | otherwise = rdrName `ltvElem` ltvs
847 noPatterns = text "Default definition for an associated synonym cannot have"
848 <+> text "type pattern"
850 repeatedTyVar tv = ptext SLIT("Illegal repeated type variable") <+>
853 -- This data decl will parse OK
855 -- treating "a" as the constructor.
856 -- It is really hard to make the parser spot this malformation.
857 -- So the renamer has to check that the constructor is legal
859 -- We can get an operator as the constructor, even in the prefix form:
860 -- data T = :% Int Int
861 -- from interface files, which always print in prefix form
863 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
866 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
870 %*********************************************************
872 \subsection{Support code to rename types}
874 %*********************************************************
877 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
880 = mappM (wrapLocM rn_fds) fds
883 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
884 rnHsTyVars doc tys2 `thenM` \ tys2' ->
885 returnM (tys1', tys2')
887 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
888 rnHsTyvar doc tyvar = lookupOccRn tyvar
892 %*********************************************************
896 %*********************************************************
902 h = ...$(thing "f")...
904 The splice can expand into literally anything, so when we do dependency
905 analysis we must assume that it might mention 'f'. So we simply treat
906 all locally-defined names as mentioned by any splice. This is terribly
907 brutal, but I don't see what else to do. For example, it'll mean
908 that every locally-defined thing will appear to be used, so no unused-binding
909 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
910 and that will crash the type checker because 'f' isn't in scope.
912 Currently, I'm not treating a splice as also mentioning every import,
913 which is a bit inconsistent -- but there are a lot of them. We might
914 thereby get some bogus unused-import warnings, but we won't crash the
915 type checker. Not very satisfactory really.
918 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
919 rnSplice (HsSplice n expr)
920 = do { checkTH expr "splice"
922 ; [n'] <- newLocalsRn [L loc n]
923 ; (expr', fvs) <- rnLExpr expr
925 -- Ugh! See Note [Splices] above
926 ; lcl_rdr <- getLocalRdrEnv
927 ; gbl_rdr <- getGlobalRdrEnv
928 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
930 lcl_names = mkNameSet (occEnvElts lcl_rdr)
932 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
935 checkTH e what = returnM () -- OK
937 checkTH e what -- Raise an error in a stage-1 compiler
938 = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
939 ptext SLIT("illegal in a stage-1 compiler"),