2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
9 rnTyClDecls, checkModDeprec,
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, lookupTopBndrRn, newLocalsRn,
27 bindLocatedLocalsFV, bindPatSigTyVarsFV,
28 bindTyVarsRn, extendTyVarEnvFVRn,
29 bindLocalNames, checkDupNames, mapFvRn
31 import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
34 import HscTypes ( FixityEnv, FixItem(..),
35 Deprecations, Deprecs(..), DeprecTxt, plusDeprecs )
36 import Class ( FunDep )
37 import Name ( Name, nameOccName )
40 import OccName ( occEnvElts )
42 import SrcLoc ( Located(..), unLoc, noLoc )
43 import DynFlags ( DynFlag(..) )
44 import Maybes ( seqMaybe )
45 import Maybe ( isNothing, isJust )
46 import Monad ( liftM, when )
47 import BasicTypes ( Boxity(..) )
50 @rnSourceDecl@ `renames' declarations.
51 It simultaneously performs dependency analysis and precedence parsing.
52 It also does the following error checks:
55 Checks that tyvars are used properly. This includes checking
56 for undefined tyvars, and tyvars in contexts that are ambiguous.
57 (Some of this checking has now been moved to module @TcMonoType@,
58 since we don't have functional dependency information at this point.)
60 Checks that all variable occurences are defined.
62 Checks the @(..)@ etc constraints in the export list.
67 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
69 rnSrcDecls (HsGroup { hs_valds = val_decls,
70 hs_tyclds = tycl_decls,
71 hs_instds = inst_decls,
72 hs_derivds = deriv_decls,
74 hs_depds = deprec_decls,
75 hs_fords = foreign_decls,
76 hs_defds = default_decls,
77 hs_ruleds = rule_decls,
80 = do { -- Deal with deprecations (returns only the extra deprecations)
81 deprecs <- rnSrcDeprecDecls deprec_decls ;
82 updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
85 -- Deal with top-level fixity decls
86 -- (returns the total new fixity env)
87 rn_fix_decls <- rnSrcFixityDecls fix_decls ;
88 fix_env <- rnSrcFixityDeclsEnv rn_fix_decls ;
89 updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
92 -- Rename other declarations
93 traceRn (text "Start rnmono") ;
94 (rn_val_decls, bind_dus) <- rnTopBinds val_decls ;
95 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
97 -- You might think that we could build proper def/use information
98 -- for type and class declarations, but they can be involved
99 -- in mutual recursion across modules, and we only do the SCC
100 -- analysis for them in the type checker.
101 -- So we content ourselves with gathering uses only; that
102 -- means we'll only report a declaration as unused if it isn't
103 -- mentioned at all. Ah well.
104 (rn_tycl_decls, src_fvs1)
105 <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls ;
106 (rn_inst_decls, src_fvs2)
107 <- mapFvRn (wrapLocFstM rnSrcInstDecl) inst_decls ;
108 (rn_deriv_decls, src_fvs_deriv)
109 <- mapFvRn (wrapLocFstM rnSrcDerivDecl) deriv_decls ;
110 (rn_rule_decls, src_fvs3)
111 <- mapFvRn (wrapLocFstM rnHsRuleDecl) rule_decls ;
112 (rn_foreign_decls, src_fvs4)
113 <- mapFvRn (wrapLocFstM rnHsForeignDecl) foreign_decls ;
114 (rn_default_decls, src_fvs5)
115 <- mapFvRn (wrapLocFstM rnDefaultDecl) default_decls ;
117 rn_docs <- mapM rnDocEntity docs ;
120 rn_group = HsGroup { hs_valds = rn_val_decls,
121 hs_tyclds = rn_tycl_decls,
122 hs_instds = rn_inst_decls,
123 hs_derivds = rn_deriv_decls,
124 hs_fixds = rn_fix_decls,
126 hs_fords = rn_foreign_decls,
127 hs_defds = rn_default_decls,
128 hs_ruleds = rn_rule_decls,
129 hs_docs = rn_docs } ;
131 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs_deriv, src_fvs3,
132 src_fvs4, src_fvs5] ;
133 src_dus = bind_dus `plusDU` usesOnly other_fvs
134 -- Note: src_dus will contain *uses* for locally-defined types
135 -- and classes, but no *defs* for them. (Because rnTyClDecl
136 -- returns only the uses.) This is a little
137 -- surprising but it doesn't actually matter at all.
140 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
141 traceRn (text "finish Dus" <+> ppr src_dus ) ;
142 tcg_env <- getGblEnv ;
143 return (tcg_env `addTcgDUs` src_dus, rn_group)
146 rnDocEntity :: DocEntity RdrName -> RnM (DocEntity Name)
147 rnDocEntity (DocEntity docdecl) = do
148 rn_docdecl <- rnDocDecl docdecl
149 return (DocEntity rn_docdecl)
150 rnDocEntity (DeclEntity name) = do
151 rn_name <- lookupTopBndrRn name
152 return (DeclEntity rn_name)
154 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
155 rnDocDecl (DocCommentNext doc) = do
156 rn_doc <- rnHsDoc doc
157 return (DocCommentNext rn_doc)
158 rnDocDecl (DocCommentPrev doc) = do
159 rn_doc <- rnHsDoc doc
160 return (DocCommentPrev rn_doc)
161 rnDocDecl (DocCommentNamed str doc) = do
162 rn_doc <- rnHsDoc doc
163 return (DocCommentNamed str rn_doc)
164 rnDocDecl (DocGroup lev doc) = do
165 rn_doc <- rnHsDoc doc
166 return (DocGroup lev rn_doc)
168 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
169 rnTyClDecls tycl_decls = do
170 (decls', fvs) <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls
173 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
174 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
178 %*********************************************************
180 Source-code fixity declarations
182 %*********************************************************
185 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
186 rnSrcFixityDecls fix_decls
187 = do fix_decls <- mapM rnFixityDecl fix_decls
188 return (concat fix_decls)
190 rnFixityDecl :: LFixitySig RdrName -> RnM [LFixitySig Name]
191 rnFixityDecl (L loc (FixitySig (L nameLoc rdr_name) fixity))
192 = setSrcSpan nameLoc $
193 -- GHC extension: look up both the tycon and data con
194 -- for con-like things
195 -- If neither are in scope, report an error; otherwise
196 -- add both to the fixity env
197 do names <- lookupLocalDataTcNames rdr_name
198 return [ L loc (FixitySig (L nameLoc name) fixity)
201 rnSrcFixityDeclsEnv :: [LFixitySig Name] -> RnM FixityEnv
202 rnSrcFixityDeclsEnv fix_decls
203 = getGblEnv `thenM` \ gbl_env ->
204 foldlM rnFixityDeclEnv (tcg_fix_env gbl_env)
205 fix_decls `thenM` \ fix_env ->
206 traceRn (text "fixity env" <+> pprFixEnv fix_env) `thenM_`
209 rnFixityDeclEnv :: FixityEnv -> LFixitySig Name -> RnM FixityEnv
210 rnFixityDeclEnv fix_env (L loc (FixitySig (L nameLoc name) fixity))
211 = case lookupNameEnv fix_env name of
212 Just (FixItem _ _ loc')
213 -> do addLocErr (L nameLoc name) (dupFixityDecl loc')
216 -> return (extendNameEnv fix_env name fix_item)
217 where fix_item = FixItem (nameOccName name) fixity nameLoc
219 pprFixEnv :: FixityEnv -> SDoc
221 = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
224 dupFixityDecl loc rdr_name
225 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
226 ptext SLIT("also at ") <+> ppr loc
231 %*********************************************************
233 Source-code deprecations declarations
235 %*********************************************************
237 For deprecations, all we do is check that the names are in scope.
238 It's only imported deprecations, dealt with in RnIfaces, that we
239 gather them together.
242 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
246 rnSrcDeprecDecls decls
247 = mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
248 returnM (DeprecSome (mkNameEnv (concat pairs_s)))
250 rn_deprec (Deprecation rdr_name txt)
251 = lookupLocalDataTcNames rdr_name `thenM` \ names ->
252 returnM [(name, (nameOccName name, txt)) | name <- names]
254 checkModDeprec :: Maybe DeprecTxt -> Deprecations
255 -- Check for a module deprecation; done once at top level
256 checkModDeprec Nothing = NoDeprecs
257 checkModDeprec (Just txt) = DeprecAll txt
260 %*********************************************************
262 \subsection{Source code declarations}
264 %*********************************************************
267 rnDefaultDecl (DefaultDecl tys)
268 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
269 returnM (DefaultDecl tys', fvs)
271 doc_str = text "In a `default' declaration"
274 %*********************************************************
276 \subsection{Foreign declarations}
278 %*********************************************************
281 rnHsForeignDecl (ForeignImport name ty spec)
282 = lookupLocatedTopBndrRn name `thenM` \ name' ->
283 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
284 returnM (ForeignImport name' ty' spec, fvs)
286 rnHsForeignDecl (ForeignExport name ty spec)
287 = lookupLocatedOccRn name `thenM` \ name' ->
288 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
289 returnM (ForeignExport name' ty' spec, fvs )
290 -- NB: a foreign export is an *occurrence site* for name, so
291 -- we add it to the free-variable list. It might, for example,
292 -- be imported from another module
294 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
298 %*********************************************************
300 \subsection{Instance declarations}
302 %*********************************************************
305 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
306 -- Used for both source and interface file decls
307 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
309 -- Rename the associated types
310 -- The typechecker (not the renamer) checks that all
311 -- the declarations are for the right class
313 at_doc = text "In the associated types of an instance declaration"
314 at_names = map (head . tyClDeclNames . unLoc) ats
316 checkDupNames at_doc at_names `thenM_`
317 rnATInsts ats `thenM` \ (ats', at_fvs) ->
319 -- Rename the bindings
320 -- The typechecker (not the renamer) checks that all
321 -- the bindings are for the right class
323 meth_doc = text "In the bindings in an instance declaration"
324 meth_names = collectHsBindLocatedBinders mbinds
325 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
327 checkDupNames meth_doc meth_names `thenM_`
328 extendTyVarEnvForMethodBinds inst_tyvars (
329 -- (Slightly strangely) the forall-d tyvars scope over
330 -- the method bindings too
331 rnMethodBinds cls (\n->[]) -- No scoped tyvars
333 ) `thenM` \ (mbinds', meth_fvs) ->
334 -- Rename the prags and signatures.
335 -- Note that the type variables are not in scope here,
336 -- so that instance Eq a => Eq (T a) where
337 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
340 -- But the (unqualified) method names are in scope
342 binders = collectHsBindBinders mbinds'
343 ok_sig = okInstDclSig (mkNameSet binders)
345 bindLocalNames binders (renameSigs ok_sig uprags) `thenM` \ uprags' ->
347 returnM (InstDecl inst_ty' mbinds' uprags' ats',
348 meth_fvs `plusFV` at_fvs
349 `plusFV` hsSigsFVs uprags'
350 `plusFV` extractHsTyNames inst_ty')
351 -- We return the renamed associated data type declarations so
352 -- that they can be entered into the list of type declarations
353 -- for the binding group, but we also keep a copy in the instance.
354 -- The latter is needed for well-formedness checks in the type
355 -- checker (eg, to ensure that all ATs of the instance actually
356 -- receive a declaration).
357 -- NB: Even the copies in the instance declaration carry copies of
358 -- the instance context after renaming. This is a bit
359 -- strange, but should not matter (and it would be more work
360 -- to remove the context).
363 Renaming of the associated types in instances.
365 * We raise an error if we encounter a kind signature in an instance.
368 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
370 mapFvRn (wrapLocFstM rnATInst) atDecls
372 rnATInst tydecl@TyFunction {} =
376 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
377 rnATInst tydecl@TyData {} =
379 checkM (not . isKindSigDecl $ tydecl) $ addErr noKindSig
382 panic "RnSource.rnATInsts: not a type declaration"
384 noKindSig = text "Instances cannot have kind signatures"
387 For the method bindings in class and instance decls, we extend the
388 type variable environment iff -fglasgow-exts
391 extendTyVarEnvForMethodBinds tyvars thing_inside
392 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
393 if opt_GlasgowExts then
394 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
399 %*********************************************************
401 \subsection{Stand-alone deriving declarations}
403 %*********************************************************
406 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
407 rnSrcDerivDecl (DerivDecl ty n)
408 = do ty' <- rnLHsType (text "a deriving decl") ty
409 n' <- lookupLocatedOccRn n
410 let fvs = extractHsTyNames ty' `addOneFV` unLoc n'
411 return (DerivDecl ty' n', fvs)
414 %*********************************************************
418 %*********************************************************
421 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
422 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
424 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
425 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
427 rnLExpr lhs `thenM` \ (lhs', fv_lhs') ->
428 rnLExpr rhs `thenM` \ (rhs', fv_rhs') ->
430 checkValidRule rule_name ids lhs' fv_lhs' `thenM_`
432 returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
433 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
435 doc = text "In the transformation rule" <+> ftext rule_name
437 get_var (RuleBndr v) = v
438 get_var (RuleBndrSig v _) = v
440 rn_var (RuleBndr (L loc v), id)
441 = returnM (RuleBndr (L loc id), emptyFVs)
442 rn_var (RuleBndrSig (L loc v) t, id)
443 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
444 returnM (RuleBndrSig (L loc id) t', fvs)
447 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
448 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
449 ptext SLIT("does not appear on left hand side")]
452 Note [Rule LHS validity checking]
453 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
454 Check the shape of a transformation rule LHS. Currently we only allow
455 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
456 @forall@'d variables.
458 We used restrict the form of the 'ei' to prevent you writing rules
459 with LHSs with a complicated desugaring (and hence unlikely to match);
460 (e.g. a case expression is not allowed: too elaborate.)
462 But there are legitimate non-trivial args ei, like sections and
463 lambdas. So it seems simmpler not to check at all, and that is why
464 check_e is commented out.
467 checkValidRule rule_name ids lhs' fv_lhs'
468 = do { -- Check for the form of the LHS
469 case (validRuleLhs ids lhs') of
471 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
473 -- Check that LHS vars are all bound
474 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
475 ; mappM (addErr . badRuleVar rule_name) bad_vars }
477 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
479 -- Just e => Not ok, and e is the offending expression
480 validRuleLhs foralls lhs
483 checkl (L loc e) = check e
485 check (OpApp e1 op _ e2) = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
486 check (HsApp e1 e2) = checkl e1 `seqMaybe` checkl_e e2
487 check (HsVar v) | v `notElem` foralls = Nothing
488 check other = Just other -- Failure
491 checkl_e (L loc e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
493 {- Commented out; see Note [Rule LHS validity checking] above
494 check_e (HsVar v) = Nothing
495 check_e (HsPar e) = checkl_e e
496 check_e (HsLit e) = Nothing
497 check_e (HsOverLit e) = Nothing
499 check_e (OpApp e1 op _ e2) = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
500 check_e (HsApp e1 e2) = checkl_e e1 `seqMaybe` checkl_e e2
501 check_e (NegApp e _) = checkl_e e
502 check_e (ExplicitList _ es) = checkl_es es
503 check_e (ExplicitTuple es _) = checkl_es es
504 check_e other = Just other -- Fails
506 checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
509 badRuleLhsErr name lhs bad_e
510 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
511 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
512 ptext SLIT("in left-hand side:") <+> ppr lhs])]
514 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
518 %*********************************************************
520 \subsection{Type, class and iface sig declarations}
522 %*********************************************************
524 @rnTyDecl@ uses the `global name function' to create a new type
525 declaration in which local names have been replaced by their original
526 names, reporting any unknown names.
528 Renaming type variables is a pain. Because they now contain uniques,
529 it is necessary to pass in an association list which maps a parsed
530 tyvar to its @Name@ representation.
531 In some cases (type signatures of values),
532 it is even necessary to go over the type first
533 in order to get the set of tyvars used by it, make an assoc list,
534 and then go over it again to rename the tyvars!
535 However, we can also do some scoping checks at the same time.
538 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
539 = lookupLocatedTopBndrRn name `thenM` \ name' ->
540 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
543 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
544 tcdLName = tycon, tcdTyVars = tyvars,
545 tcdTyPats = typatsMaybe, tcdCons = condecls,
546 tcdKindSig = sig, tcdDerivs = derivs})
547 | isKindSigDecl tydecl -- kind signature of indexed type
548 = rnTySig tydecl bindTyVarsRn
549 | is_vanilla -- Normal Haskell data type decl
550 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
551 -- data type is syntactically illegal
552 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
553 do { tycon' <- if isIdxTyDecl tydecl
554 then lookupLocatedOccRn tycon -- may be imported family
555 else lookupLocatedTopBndrRn tycon
556 ; context' <- rnContext data_doc context
557 ; typats' <- rnTyPats data_doc typatsMaybe
558 ; (derivs', deriv_fvs) <- rn_derivs derivs
559 ; checkDupNames data_doc con_names
560 ; condecls' <- rnConDecls (unLoc tycon') condecls
561 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
562 tcdLName = tycon', tcdTyVars = tyvars',
563 tcdTyPats = typats', tcdKindSig = Nothing,
564 tcdCons = condecls', tcdDerivs = derivs'},
565 delFVs (map hsLTyVarName tyvars') $
566 extractHsCtxtTyNames context' `plusFV`
567 plusFVs (map conDeclFVs condecls') `plusFV`
569 (if isIdxTyDecl tydecl
570 then unitFV (unLoc tycon') -- type instance => use
575 = ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
576 do { tycon' <- if isIdxTyDecl tydecl
577 then lookupLocatedOccRn tycon -- may be imported family
578 else lookupLocatedTopBndrRn tycon
579 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
580 ; tyvars' <- bindTyVarsRn data_doc tyvars
581 (\ tyvars' -> return tyvars')
582 -- For GADTs, the type variables in the declaration
583 -- do not scope over the constructor signatures
584 -- data T a where { T1 :: forall b. b-> b }
585 ; (derivs', deriv_fvs) <- rn_derivs derivs
586 ; checkDupNames data_doc con_names
587 ; condecls' <- rnConDecls (unLoc tycon') condecls
588 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
589 tcdLName = tycon', tcdTyVars = tyvars',
590 tcdTyPats = Nothing, tcdKindSig = sig,
591 tcdCons = condecls', tcdDerivs = derivs'},
592 plusFVs (map conDeclFVs condecls') `plusFV`
594 (if isIdxTyDecl tydecl
595 then unitFV (unLoc tycon') -- type instance => use
599 is_vanilla = case condecls of -- Yuk
601 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
605 none (Just []) = True
608 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
609 con_names = map con_names_helper condecls
611 con_names_helper (L _ c) = con_name c
613 rn_derivs Nothing = returnM (Nothing, emptyFVs)
614 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
615 returnM (Just ds', extractHsTyNames_s ds')
617 rnTyClDecl (tydecl@TyFunction {}) =
618 rnTySig tydecl bindTyVarsRn
620 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
621 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
622 = bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
623 do { name' <- if isIdxTyDecl tydecl
624 then lookupLocatedOccRn name -- may be imported family
625 else lookupLocatedTopBndrRn name
626 ; typats' <- rnTyPats syn_doc typatsMaybe
627 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
628 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
629 tcdTyPats = typats', tcdSynRhs = ty'},
630 delFVs (map hsLTyVarName tyvars') $
632 (if isIdxTyDecl tydecl
633 then unitFV (unLoc name') -- type instance => use
637 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
639 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
640 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
641 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
642 = lookupLocatedTopBndrRn cname `thenM` \ cname' ->
644 -- Tyvars scope over superclass context and method signatures
645 bindTyVarsRn cls_doc tyvars ( \ tyvars' ->
646 rnContext cls_doc context `thenM` \ context' ->
647 rnFds cls_doc fds `thenM` \ fds' ->
648 rnATs ats `thenM` \ (ats', ats_fvs) ->
649 renameSigs okClsDclSig sigs `thenM` \ sigs' ->
650 mapM rnDocEntity docs `thenM` \ docs' ->
651 returnM (tyvars', context', fds', (ats', ats_fvs), sigs', docs')
652 ) `thenM` \ (tyvars', context', fds', (ats', ats_fvs), sigs', docs') ->
654 -- Check for duplicates among the associated types
656 at_rdr_names_w_locs = [tcdLName ty | L _ ty <- ats]
658 checkDupNames at_doc at_rdr_names_w_locs `thenM_`
660 -- Check the signatures
661 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
663 sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
665 checkDupNames sig_doc sig_rdr_names_w_locs `thenM_`
666 -- Typechecker is responsible for checking that we only
667 -- give default-method bindings for things in this class.
668 -- The renamer *could* check this for class decls, but can't
669 -- for instance decls.
671 -- The newLocals call is tiresome: given a generic class decl
674 -- op {| x+y |} (Inl a) = ...
675 -- op {| x+y |} (Inr b) = ...
676 -- op {| a*b |} (a*b) = ...
677 -- we want to name both "x" tyvars with the same unique, so that they are
678 -- easy to group together in the typechecker.
679 extendTyVarEnvForMethodBinds tyvars' (
680 getLocalRdrEnv `thenM` \ name_env ->
682 meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
683 gen_rdr_tyvars_w_locs =
684 [ tv | tv <- extractGenericPatTyVars mbinds,
685 not (unLoc tv `elemLocalRdrEnv` name_env) ]
687 checkDupNames meth_doc meth_rdr_names_w_locs `thenM_`
688 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
689 rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds
690 ) `thenM` \ (mbinds', meth_fvs) ->
692 returnM (ClassDecl { tcdCtxt = context', tcdLName = cname',
693 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
694 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
695 delFVs (map hsLTyVarName tyvars') $
696 extractHsCtxtTyNames context' `plusFV`
697 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
698 hsSigsFVs sigs' `plusFV`
702 meth_doc = text "In the default-methods for class" <+> ppr cname
703 cls_doc = text "In the declaration for class" <+> ppr cname
704 sig_doc = text "In the signatures for class" <+> ppr cname
705 at_doc = text "In the associated types for class" <+> ppr cname
707 badGadtStupidTheta tycon
708 = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
709 ptext SLIT("(You can put a context on each contructor, though.)")]
712 %*********************************************************
714 \subsection{Support code for type/data declarations}
716 %*********************************************************
719 -- Although, we are processing type patterns here, all type variables will
720 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
721 -- type declaration to which these patterns belong)
723 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
724 rnTyPats _ Nothing = return Nothing
725 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
727 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
728 rnConDecls tycon condecls
729 = mappM (wrapLocM rnConDecl) condecls
731 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
732 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
733 = do { addLocM checkConName name
735 ; new_name <- lookupLocatedTopBndrRn name
736 ; name_env <- getLocalRdrEnv
738 -- For H98 syntax, the tvs are the existential ones
739 -- For GADT syntax, the tvs are all the quantified tyvars
740 -- Hence the 'filter' in the ResTyH98 case only
741 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
742 arg_tys = hsConArgs details
743 implicit_tvs = case res_ty of
744 ResTyH98 -> filter not_in_scope $
746 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
749 Implicit -> userHsTyVarBndrs implicit_tvs
751 ; mb_doc' <- rnMbLHsDoc mb_doc
753 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
754 { new_context <- rnContext doc cxt
755 ; new_details <- rnConDetails doc details
756 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
757 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
759 doc = text "In the definition of data constructor" <+> quotes (ppr name)
760 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
762 rnConResult _ details ResTyH98 = return (details, ResTyH98)
764 rnConResult doc details (ResTyGADT ty) = do
765 ty' <- rnHsSigType doc ty
766 let (arg_tys, res_ty) = splitHsFunType ty'
767 -- We can split it up, now the renamer has dealt with fixities
769 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
770 RecCon fields -> return (details, ResTyGADT ty')
771 InfixCon {} -> panic "rnConResult"
773 rnConDetails doc (PrefixCon tys)
774 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
775 returnM (PrefixCon new_tys)
777 rnConDetails doc (InfixCon ty1 ty2)
778 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
779 rnLHsType doc ty2 `thenM` \ new_ty2 ->
780 returnM (InfixCon new_ty1 new_ty2)
782 rnConDetails doc (RecCon fields)
783 = checkDupNames doc field_names `thenM_`
784 mappM (rnField doc) fields `thenM` \ new_fields ->
785 returnM (RecCon new_fields)
787 field_names = [ name | HsRecField name _ _ <- fields ]
789 -- Document comments are renamed to Nothing here
790 rnField doc (HsRecField name ty haddock_doc)
791 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
792 rnLHsType doc ty `thenM` \ new_ty ->
793 rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
794 returnM (HsRecField new_name new_ty new_haddock_doc)
796 -- Rename kind signatures (signatures of indexed data types/newtypes and
797 -- signatures of type functions)
799 -- * This function is parametrised by the routine handling the index
800 -- variables. On the toplevel, these are defining occurences, whereas they
801 -- are usage occurences for associated types.
803 rnTySig :: TyClDecl RdrName
804 -> (SDoc -> [LHsTyVarBndr RdrName] ->
805 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
806 RnM (TyClDecl Name, FreeVars))
807 -> RnM (TyClDecl Name, FreeVars)
809 rnTySig (tydecl@TyData {tcdCtxt = context, tcdLName = tycon,
810 tcdTyVars = tyvars, tcdTyPats = mb_typats,
811 tcdCons = condecls, tcdKindSig = sig,
814 ASSERT( null condecls ) -- won't have constructors
815 ASSERT( isNothing mb_typats ) -- won't have type patterns
816 ASSERT( isNothing derivs ) -- won't have deriving
817 ASSERT( isJust sig ) -- will have kind signature
818 do { checkM (not . null $ tyvars) $ addErr needOneIdx -- #indexes >= 1
819 ; bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
820 ; tycon' <- lookupLocatedTopBndrRn tycon
821 ; context' <- rnContext (ksig_doc tycon) context
822 ; returnM (TyData {tcdND = tcdND tydecl, tcdCtxt = context',
823 tcdLName = tycon', tcdTyVars = tyvars',
824 tcdTyPats = Nothing, tcdKindSig = sig,
825 tcdCons = [], tcdDerivs = Nothing},
826 delFVs (map hsLTyVarName tyvars') $
827 extractHsCtxtTyNames context')
831 rnTySig (tydecl@TyFunction {tcdLName = tycon, tcdTyVars = tyvars,
834 do { checkM (not . null $ tyvars) $ addErr needOneIdx -- #indexes >= 1
835 ; bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
836 ; tycon' <- lookupLocatedTopBndrRn tycon
837 ; returnM (TyFunction {tcdLName = tycon', tcdTyVars = tyvars',
838 tcdIso = tcdIso tydecl, tcdKind = sig},
842 ksig_doc tycon = text "In the kind signature for" <+> quotes (ppr tycon)
843 needOneIdx = text "Kind signature requires at least one type index"
845 -- Rename associated type declarations (in classes)
847 -- * This can be kind signatures and (default) type function equations.
849 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
850 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
852 rn_at (tydecl@TyData {}) = rnTySig tydecl lookupIdxVars
853 rn_at (tydecl@TyFunction {}) = rnTySig tydecl lookupIdxVars
854 rn_at (tydecl@TySynonym {}) =
856 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
858 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
860 lookupIdxVars _ tyvars cont =
861 do { checkForDups tyvars;
862 ; tyvars' <- mappM lookupIdxVar tyvars
865 -- Type index variables must be class parameters, which are the only
866 -- type variables in scope at this point.
867 lookupIdxVar (L l tyvar) =
869 name' <- lookupOccRn (hsTyVarName tyvar)
870 return $ L l (replaceTyVarName tyvar name')
872 -- Type variable may only occur once.
874 checkForDups [] = return ()
875 checkForDups (L loc tv:ltvs) =
876 do { setSrcSpan loc $
877 when (hsTyVarName tv `ltvElem` ltvs) $
878 addErr (repeatedTyVar tv)
882 rdrName `ltvElem` [] = False
883 rdrName `ltvElem` (L _ tv:ltvs)
884 | rdrName == hsTyVarName tv = True
885 | otherwise = rdrName `ltvElem` ltvs
887 noPatterns = text "Default definition for an associated synonym cannot have"
888 <+> text "type pattern"
890 repeatedTyVar tv = ptext SLIT("Illegal repeated type variable") <+>
893 -- This data decl will parse OK
895 -- treating "a" as the constructor.
896 -- It is really hard to make the parser spot this malformation.
897 -- So the renamer has to check that the constructor is legal
899 -- We can get an operator as the constructor, even in the prefix form:
900 -- data T = :% Int Int
901 -- from interface files, which always print in prefix form
903 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
906 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
910 %*********************************************************
912 \subsection{Support code to rename types}
914 %*********************************************************
917 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
920 = mappM (wrapLocM rn_fds) fds
923 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
924 rnHsTyVars doc tys2 `thenM` \ tys2' ->
925 returnM (tys1', tys2')
927 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
928 rnHsTyvar doc tyvar = lookupOccRn tyvar
932 %*********************************************************
936 %*********************************************************
942 h = ...$(thing "f")...
944 The splice can expand into literally anything, so when we do dependency
945 analysis we must assume that it might mention 'f'. So we simply treat
946 all locally-defined names as mentioned by any splice. This is terribly
947 brutal, but I don't see what else to do. For example, it'll mean
948 that every locally-defined thing will appear to be used, so no unused-binding
949 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
950 and that will crash the type checker because 'f' isn't in scope.
952 Currently, I'm not treating a splice as also mentioning every import,
953 which is a bit inconsistent -- but there are a lot of them. We might
954 thereby get some bogus unused-import warnings, but we won't crash the
955 type checker. Not very satisfactory really.
958 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
959 rnSplice (HsSplice n expr)
960 = do { checkTH expr "splice"
962 ; [n'] <- newLocalsRn [L loc n]
963 ; (expr', fvs) <- rnLExpr expr
965 -- Ugh! See Note [Splices] above
966 ; lcl_rdr <- getLocalRdrEnv
967 ; gbl_rdr <- getGlobalRdrEnv
968 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
970 lcl_names = mkNameSet (occEnvElts lcl_rdr)
972 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
975 checkTH e what = returnM () -- OK
977 checkTH e what -- Raise an error in a stage-1 compiler
978 = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
979 ptext SLIT("illegal in a stage-1 compiler"),