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 traceRn (text "Start rnTyClDecls") ;
105 (rn_tycl_decls, src_fvs1)
106 <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls ;
107 traceRn (text "finish rnTyClDecls") ;
108 (rn_inst_decls, src_fvs2)
109 <- mapFvRn (wrapLocFstM rnSrcInstDecl) inst_decls ;
110 (rn_deriv_decls, src_fvs_deriv)
111 <- mapFvRn (wrapLocFstM rnSrcDerivDecl) deriv_decls ;
112 (rn_rule_decls, src_fvs3)
113 <- mapFvRn (wrapLocFstM rnHsRuleDecl) rule_decls ;
114 (rn_foreign_decls, src_fvs4)
115 <- mapFvRn (wrapLocFstM rnHsForeignDecl) foreign_decls ;
116 (rn_default_decls, src_fvs5)
117 <- mapFvRn (wrapLocFstM rnDefaultDecl) default_decls ;
119 -- At this point, stop if we have found errors. Otherwise
120 -- the rnDocEntity stuff reports the errors again.
123 traceRn (text "Start rnDocEntitys") ;
124 rn_docs <- mapM rnDocEntity docs ;
125 traceRn (text "finish rnDocEntitys") ;
128 rn_group = HsGroup { hs_valds = rn_val_decls,
129 hs_tyclds = rn_tycl_decls,
130 hs_instds = rn_inst_decls,
131 hs_derivds = rn_deriv_decls,
132 hs_fixds = rn_fix_decls,
134 hs_fords = rn_foreign_decls,
135 hs_defds = rn_default_decls,
136 hs_ruleds = rn_rule_decls,
137 hs_docs = rn_docs } ;
139 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs_deriv, src_fvs3,
140 src_fvs4, src_fvs5] ;
141 src_dus = bind_dus `plusDU` usesOnly other_fvs
142 -- Note: src_dus will contain *uses* for locally-defined types
143 -- and classes, but no *defs* for them. (Because rnTyClDecl
144 -- returns only the uses.) This is a little
145 -- surprising but it doesn't actually matter at all.
148 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
149 traceRn (text "finish Dus" <+> ppr src_dus ) ;
150 tcg_env <- getGblEnv ;
151 return (tcg_env `addTcgDUs` src_dus, rn_group)
154 rnDocEntity :: DocEntity RdrName -> RnM (DocEntity Name)
155 rnDocEntity (DocEntity docdecl) = do
156 rn_docdecl <- rnDocDecl docdecl
157 return (DocEntity rn_docdecl)
158 rnDocEntity (DeclEntity name) = do
159 rn_name <- lookupTopBndrRn name
160 return (DeclEntity rn_name)
162 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
163 rnDocDecl (DocCommentNext doc) = do
164 rn_doc <- rnHsDoc doc
165 return (DocCommentNext rn_doc)
166 rnDocDecl (DocCommentPrev doc) = do
167 rn_doc <- rnHsDoc doc
168 return (DocCommentPrev rn_doc)
169 rnDocDecl (DocCommentNamed str doc) = do
170 rn_doc <- rnHsDoc doc
171 return (DocCommentNamed str rn_doc)
172 rnDocDecl (DocGroup lev doc) = do
173 rn_doc <- rnHsDoc doc
174 return (DocGroup lev rn_doc)
176 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
177 rnTyClDecls tycl_decls = do
178 (decls', fvs) <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls
181 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
182 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
186 %*********************************************************
188 Source-code fixity declarations
190 %*********************************************************
193 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
194 rnSrcFixityDecls fix_decls
195 = do fix_decls <- mapM rnFixityDecl fix_decls
196 return (concat fix_decls)
198 rnFixityDecl :: LFixitySig RdrName -> RnM [LFixitySig Name]
199 rnFixityDecl (L loc (FixitySig (L nameLoc rdr_name) fixity))
200 = setSrcSpan nameLoc $
201 -- GHC extension: look up both the tycon and data con
202 -- for con-like things
203 -- If neither are in scope, report an error; otherwise
204 -- add both to the fixity env
205 do names <- lookupLocalDataTcNames rdr_name
206 return [ L loc (FixitySig (L nameLoc name) fixity)
209 rnSrcFixityDeclsEnv :: [LFixitySig Name] -> RnM FixityEnv
210 rnSrcFixityDeclsEnv fix_decls
211 = getGblEnv `thenM` \ gbl_env ->
212 foldlM rnFixityDeclEnv (tcg_fix_env gbl_env)
213 fix_decls `thenM` \ fix_env ->
214 traceRn (text "fixity env" <+> pprFixEnv fix_env) `thenM_`
217 rnFixityDeclEnv :: FixityEnv -> LFixitySig Name -> RnM FixityEnv
218 rnFixityDeclEnv fix_env (L loc (FixitySig (L nameLoc name) fixity))
219 = case lookupNameEnv fix_env name of
220 Just (FixItem _ _ loc')
221 -> do addLocErr (L nameLoc name) (dupFixityDecl loc')
224 -> return (extendNameEnv fix_env name fix_item)
225 where fix_item = FixItem (nameOccName name) fixity nameLoc
227 pprFixEnv :: FixityEnv -> SDoc
229 = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
232 dupFixityDecl loc rdr_name
233 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
234 ptext SLIT("also at ") <+> ppr loc
239 %*********************************************************
241 Source-code deprecations declarations
243 %*********************************************************
245 For deprecations, all we do is check that the names are in scope.
246 It's only imported deprecations, dealt with in RnIfaces, that we
247 gather them together.
250 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
254 rnSrcDeprecDecls decls
255 = mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
256 returnM (DeprecSome (mkNameEnv (concat pairs_s)))
258 rn_deprec (Deprecation rdr_name txt)
259 = lookupLocalDataTcNames rdr_name `thenM` \ names ->
260 returnM [(name, (nameOccName name, txt)) | name <- names]
262 checkModDeprec :: Maybe DeprecTxt -> Deprecations
263 -- Check for a module deprecation; done once at top level
264 checkModDeprec Nothing = NoDeprecs
265 checkModDeprec (Just txt) = DeprecAll txt
268 %*********************************************************
270 \subsection{Source code declarations}
272 %*********************************************************
275 rnDefaultDecl (DefaultDecl tys)
276 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
277 returnM (DefaultDecl tys', fvs)
279 doc_str = text "In a `default' declaration"
282 %*********************************************************
284 \subsection{Foreign declarations}
286 %*********************************************************
289 rnHsForeignDecl (ForeignImport name ty spec)
290 = lookupLocatedTopBndrRn name `thenM` \ name' ->
291 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
292 returnM (ForeignImport name' ty' spec, fvs)
294 rnHsForeignDecl (ForeignExport name ty spec)
295 = lookupLocatedOccRn name `thenM` \ name' ->
296 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
297 returnM (ForeignExport name' ty' spec, fvs )
298 -- NB: a foreign export is an *occurrence site* for name, so
299 -- we add it to the free-variable list. It might, for example,
300 -- be imported from another module
302 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
306 %*********************************************************
308 \subsection{Instance declarations}
310 %*********************************************************
313 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
314 -- Used for both source and interface file decls
315 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
317 -- Rename the associated types
318 -- The typechecker (not the renamer) checks that all
319 -- the declarations are for the right class
321 at_doc = text "In the associated types of an instance declaration"
322 at_names = map (head . tyClDeclNames . unLoc) ats
324 checkDupNames at_doc at_names `thenM_`
325 rnATInsts ats `thenM` \ (ats', at_fvs) ->
327 -- Rename the bindings
328 -- The typechecker (not the renamer) checks that all
329 -- the bindings are for the right class
331 meth_doc = text "In the bindings in an instance declaration"
332 meth_names = collectHsBindLocatedBinders mbinds
333 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
335 checkDupNames meth_doc meth_names `thenM_`
336 extendTyVarEnvForMethodBinds inst_tyvars (
337 -- (Slightly strangely) the forall-d tyvars scope over
338 -- the method bindings too
339 rnMethodBinds cls (\n->[]) -- No scoped tyvars
341 ) `thenM` \ (mbinds', meth_fvs) ->
342 -- Rename the prags and signatures.
343 -- Note that the type variables are not in scope here,
344 -- so that instance Eq a => Eq (T a) where
345 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
348 -- But the (unqualified) method names are in scope
350 binders = collectHsBindBinders mbinds'
351 ok_sig = okInstDclSig (mkNameSet binders)
353 bindLocalNames binders (renameSigs ok_sig uprags) `thenM` \ uprags' ->
355 returnM (InstDecl inst_ty' mbinds' uprags' ats',
356 meth_fvs `plusFV` at_fvs
357 `plusFV` hsSigsFVs uprags'
358 `plusFV` extractHsTyNames inst_ty')
359 -- We return the renamed associated data type declarations so
360 -- that they can be entered into the list of type declarations
361 -- for the binding group, but we also keep a copy in the instance.
362 -- The latter is needed for well-formedness checks in the type
363 -- checker (eg, to ensure that all ATs of the instance actually
364 -- receive a declaration).
365 -- NB: Even the copies in the instance declaration carry copies of
366 -- the instance context after renaming. This is a bit
367 -- strange, but should not matter (and it would be more work
368 -- to remove the context).
371 Renaming of the associated types in instances.
373 * We raise an error if we encounter a kind signature in an instance.
376 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
378 mapFvRn (wrapLocFstM rnATInst) atDecls
380 rnATInst tydecl@TyFunction {} =
384 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
385 rnATInst tydecl@TyData {} =
387 checkM (not . isKindSigDecl $ tydecl) $ addErr noKindSig
390 panic "RnSource.rnATInsts: not a type declaration"
392 noKindSig = text "Instances cannot have kind signatures"
395 For the method bindings in class and instance decls, we extend the
396 type variable environment iff -fglasgow-exts
399 extendTyVarEnvForMethodBinds tyvars thing_inside
400 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
401 if opt_GlasgowExts then
402 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
407 %*********************************************************
409 \subsection{Stand-alone deriving declarations}
411 %*********************************************************
414 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
415 rnSrcDerivDecl (DerivDecl ty n)
416 = do ty' <- rnLHsType (text "a deriving decl") ty
417 n' <- lookupLocatedOccRn n
418 let fvs = extractHsTyNames ty' `addOneFV` unLoc n'
419 return (DerivDecl ty' n', fvs)
422 %*********************************************************
426 %*********************************************************
429 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
430 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
432 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
433 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
435 rnLExpr lhs `thenM` \ (lhs', fv_lhs') ->
436 rnLExpr rhs `thenM` \ (rhs', fv_rhs') ->
438 checkValidRule rule_name ids lhs' fv_lhs' `thenM_`
440 returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
441 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
443 doc = text "In the transformation rule" <+> ftext rule_name
445 get_var (RuleBndr v) = v
446 get_var (RuleBndrSig v _) = v
448 rn_var (RuleBndr (L loc v), id)
449 = returnM (RuleBndr (L loc id), emptyFVs)
450 rn_var (RuleBndrSig (L loc v) t, id)
451 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
452 returnM (RuleBndrSig (L loc id) t', fvs)
455 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
456 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
457 ptext SLIT("does not appear on left hand side")]
460 Note [Rule LHS validity checking]
461 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
462 Check the shape of a transformation rule LHS. Currently we only allow
463 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
464 @forall@'d variables.
466 We used restrict the form of the 'ei' to prevent you writing rules
467 with LHSs with a complicated desugaring (and hence unlikely to match);
468 (e.g. a case expression is not allowed: too elaborate.)
470 But there are legitimate non-trivial args ei, like sections and
471 lambdas. So it seems simmpler not to check at all, and that is why
472 check_e is commented out.
475 checkValidRule rule_name ids lhs' fv_lhs'
476 = do { -- Check for the form of the LHS
477 case (validRuleLhs ids lhs') of
479 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
481 -- Check that LHS vars are all bound
482 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
483 ; mappM (addErr . badRuleVar rule_name) bad_vars }
485 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
487 -- Just e => Not ok, and e is the offending expression
488 validRuleLhs foralls lhs
491 checkl (L loc e) = check e
493 check (OpApp e1 op _ e2) = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
494 check (HsApp e1 e2) = checkl e1 `seqMaybe` checkl_e e2
495 check (HsVar v) | v `notElem` foralls = Nothing
496 check other = Just other -- Failure
499 checkl_e (L loc e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
501 {- Commented out; see Note [Rule LHS validity checking] above
502 check_e (HsVar v) = Nothing
503 check_e (HsPar e) = checkl_e e
504 check_e (HsLit e) = Nothing
505 check_e (HsOverLit e) = Nothing
507 check_e (OpApp e1 op _ e2) = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
508 check_e (HsApp e1 e2) = checkl_e e1 `seqMaybe` checkl_e e2
509 check_e (NegApp e _) = checkl_e e
510 check_e (ExplicitList _ es) = checkl_es es
511 check_e (ExplicitTuple es _) = checkl_es es
512 check_e other = Just other -- Fails
514 checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
517 badRuleLhsErr name lhs bad_e
518 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
519 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
520 ptext SLIT("in left-hand side:") <+> ppr lhs])]
522 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
526 %*********************************************************
528 \subsection{Type, class and iface sig declarations}
530 %*********************************************************
532 @rnTyDecl@ uses the `global name function' to create a new type
533 declaration in which local names have been replaced by their original
534 names, reporting any unknown names.
536 Renaming type variables is a pain. Because they now contain uniques,
537 it is necessary to pass in an association list which maps a parsed
538 tyvar to its @Name@ representation.
539 In some cases (type signatures of values),
540 it is even necessary to go over the type first
541 in order to get the set of tyvars used by it, make an assoc list,
542 and then go over it again to rename the tyvars!
543 However, we can also do some scoping checks at the same time.
546 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
547 = lookupLocatedTopBndrRn name `thenM` \ name' ->
548 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
551 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
552 tcdLName = tycon, tcdTyVars = tyvars,
553 tcdTyPats = typatsMaybe, tcdCons = condecls,
554 tcdKindSig = sig, tcdDerivs = derivs})
555 | isKindSigDecl tydecl -- kind signature of indexed type
556 = rnTySig tydecl bindTyVarsRn
557 | is_vanilla -- Normal Haskell data type decl
558 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
559 -- data type is syntactically illegal
560 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
561 do { tycon' <- if isIdxTyDecl tydecl
562 then lookupLocatedOccRn tycon -- may be imported family
563 else lookupLocatedTopBndrRn tycon
564 ; context' <- rnContext data_doc context
565 ; typats' <- rnTyPats data_doc typatsMaybe
566 ; (derivs', deriv_fvs) <- rn_derivs derivs
567 ; checkDupNames data_doc con_names
568 ; condecls' <- rnConDecls (unLoc tycon') condecls
569 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
570 tcdLName = tycon', tcdTyVars = tyvars',
571 tcdTyPats = typats', tcdKindSig = Nothing,
572 tcdCons = condecls', tcdDerivs = derivs'},
573 delFVs (map hsLTyVarName tyvars') $
574 extractHsCtxtTyNames context' `plusFV`
575 plusFVs (map conDeclFVs condecls') `plusFV`
577 (if isIdxTyDecl tydecl
578 then unitFV (unLoc tycon') -- type instance => use
583 = ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
584 do { tycon' <- if isIdxTyDecl tydecl
585 then lookupLocatedOccRn tycon -- may be imported family
586 else lookupLocatedTopBndrRn tycon
587 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
588 ; tyvars' <- bindTyVarsRn data_doc tyvars
589 (\ tyvars' -> return tyvars')
590 -- For GADTs, the type variables in the declaration
591 -- do not scope over the constructor signatures
592 -- data T a where { T1 :: forall b. b-> b }
593 ; (derivs', deriv_fvs) <- rn_derivs derivs
594 ; checkDupNames data_doc con_names
595 ; condecls' <- rnConDecls (unLoc tycon') condecls
596 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
597 tcdLName = tycon', tcdTyVars = tyvars',
598 tcdTyPats = Nothing, tcdKindSig = sig,
599 tcdCons = condecls', tcdDerivs = derivs'},
600 plusFVs (map conDeclFVs condecls') `plusFV`
602 (if isIdxTyDecl tydecl
603 then unitFV (unLoc tycon') -- type instance => use
607 is_vanilla = case condecls of -- Yuk
609 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
613 none (Just []) = True
616 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
617 con_names = map con_names_helper condecls
619 con_names_helper (L _ c) = con_name c
621 rn_derivs Nothing = returnM (Nothing, emptyFVs)
622 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
623 returnM (Just ds', extractHsTyNames_s ds')
625 rnTyClDecl (tydecl@TyFunction {}) =
626 rnTySig tydecl bindTyVarsRn
628 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
629 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
630 = bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
631 do { name' <- if isIdxTyDecl tydecl
632 then lookupLocatedOccRn name -- may be imported family
633 else lookupLocatedTopBndrRn name
634 ; typats' <- rnTyPats syn_doc typatsMaybe
635 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
636 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
637 tcdTyPats = typats', tcdSynRhs = ty'},
638 delFVs (map hsLTyVarName tyvars') $
640 (if isIdxTyDecl tydecl
641 then unitFV (unLoc name') -- type instance => use
645 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
647 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
648 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
649 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
650 = lookupLocatedTopBndrRn cname `thenM` \ cname' ->
652 -- Tyvars scope over superclass context and method signatures
653 bindTyVarsRn cls_doc tyvars ( \ tyvars' ->
654 rnContext cls_doc context `thenM` \ context' ->
655 rnFds cls_doc fds `thenM` \ fds' ->
656 rnATs ats `thenM` \ (ats', ats_fvs) ->
657 renameSigs okClsDclSig sigs `thenM` \ sigs' ->
658 mapM rnDocEntity docs `thenM` \ docs' ->
659 returnM (tyvars', context', fds', (ats', ats_fvs), sigs', docs')
660 ) `thenM` \ (tyvars', context', fds', (ats', ats_fvs), sigs', docs') ->
662 -- Check for duplicates among the associated types
664 at_rdr_names_w_locs = [tcdLName ty | L _ ty <- ats]
666 checkDupNames at_doc at_rdr_names_w_locs `thenM_`
668 -- Check the signatures
669 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
671 sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
673 checkDupNames sig_doc sig_rdr_names_w_locs `thenM_`
674 -- Typechecker is responsible for checking that we only
675 -- give default-method bindings for things in this class.
676 -- The renamer *could* check this for class decls, but can't
677 -- for instance decls.
679 -- The newLocals call is tiresome: given a generic class decl
682 -- op {| x+y |} (Inl a) = ...
683 -- op {| x+y |} (Inr b) = ...
684 -- op {| a*b |} (a*b) = ...
685 -- we want to name both "x" tyvars with the same unique, so that they are
686 -- easy to group together in the typechecker.
687 extendTyVarEnvForMethodBinds tyvars' (
688 getLocalRdrEnv `thenM` \ name_env ->
690 meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
691 gen_rdr_tyvars_w_locs =
692 [ tv | tv <- extractGenericPatTyVars mbinds,
693 not (unLoc tv `elemLocalRdrEnv` name_env) ]
695 checkDupNames meth_doc meth_rdr_names_w_locs `thenM_`
696 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
697 rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds
698 ) `thenM` \ (mbinds', meth_fvs) ->
700 returnM (ClassDecl { tcdCtxt = context', tcdLName = cname',
701 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
702 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
703 delFVs (map hsLTyVarName tyvars') $
704 extractHsCtxtTyNames context' `plusFV`
705 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
706 hsSigsFVs sigs' `plusFV`
710 meth_doc = text "In the default-methods for class" <+> ppr cname
711 cls_doc = text "In the declaration for class" <+> ppr cname
712 sig_doc = text "In the signatures for class" <+> ppr cname
713 at_doc = text "In the associated types for class" <+> ppr cname
715 badGadtStupidTheta tycon
716 = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
717 ptext SLIT("(You can put a context on each contructor, though.)")]
720 %*********************************************************
722 \subsection{Support code for type/data declarations}
724 %*********************************************************
727 -- Although, we are processing type patterns here, all type variables will
728 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
729 -- type declaration to which these patterns belong)
731 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
732 rnTyPats _ Nothing = return Nothing
733 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
735 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
736 rnConDecls tycon condecls
737 = mappM (wrapLocM rnConDecl) condecls
739 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
740 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
741 = do { addLocM checkConName name
743 ; new_name <- lookupLocatedTopBndrRn name
744 ; name_env <- getLocalRdrEnv
746 -- For H98 syntax, the tvs are the existential ones
747 -- For GADT syntax, the tvs are all the quantified tyvars
748 -- Hence the 'filter' in the ResTyH98 case only
749 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
750 arg_tys = hsConArgs details
751 implicit_tvs = case res_ty of
752 ResTyH98 -> filter not_in_scope $
754 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
757 Implicit -> userHsTyVarBndrs implicit_tvs
759 ; mb_doc' <- rnMbLHsDoc mb_doc
761 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
762 { new_context <- rnContext doc cxt
763 ; new_details <- rnConDetails doc details
764 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
765 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
767 doc = text "In the definition of data constructor" <+> quotes (ppr name)
768 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
770 rnConResult _ details ResTyH98 = return (details, ResTyH98)
772 rnConResult doc details (ResTyGADT ty) = do
773 ty' <- rnHsSigType doc ty
774 let (arg_tys, res_ty) = splitHsFunType ty'
775 -- We can split it up, now the renamer has dealt with fixities
777 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
778 RecCon fields -> return (details, ResTyGADT ty')
779 InfixCon {} -> panic "rnConResult"
781 rnConDetails doc (PrefixCon tys)
782 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
783 returnM (PrefixCon new_tys)
785 rnConDetails doc (InfixCon ty1 ty2)
786 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
787 rnLHsType doc ty2 `thenM` \ new_ty2 ->
788 returnM (InfixCon new_ty1 new_ty2)
790 rnConDetails doc (RecCon fields)
791 = checkDupNames doc field_names `thenM_`
792 mappM (rnField doc) fields `thenM` \ new_fields ->
793 returnM (RecCon new_fields)
795 field_names = [ name | HsRecField name _ _ <- fields ]
797 -- Document comments are renamed to Nothing here
798 rnField doc (HsRecField name ty haddock_doc)
799 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
800 rnLHsType doc ty `thenM` \ new_ty ->
801 rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
802 returnM (HsRecField new_name new_ty new_haddock_doc)
804 -- Rename kind signatures (signatures of indexed data types/newtypes and
805 -- signatures of type functions)
807 -- * This function is parametrised by the routine handling the index
808 -- variables. On the toplevel, these are defining occurences, whereas they
809 -- are usage occurences for associated types.
811 rnTySig :: TyClDecl RdrName
812 -> (SDoc -> [LHsTyVarBndr RdrName] ->
813 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
814 RnM (TyClDecl Name, FreeVars))
815 -> RnM (TyClDecl Name, FreeVars)
817 rnTySig (tydecl@TyData {tcdCtxt = context, tcdLName = tycon,
818 tcdTyVars = tyvars, tcdTyPats = mb_typats,
819 tcdCons = condecls, tcdKindSig = sig,
822 ASSERT( null condecls ) -- won't have constructors
823 ASSERT( isNothing mb_typats ) -- won't have type patterns
824 ASSERT( isNothing derivs ) -- won't have deriving
825 ASSERT( isJust sig ) -- will have kind signature
826 do { checkM (not . null $ tyvars) $ addErr needOneIdx -- #indexes >= 1
827 ; bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
828 ; tycon' <- lookupLocatedTopBndrRn tycon
829 ; context' <- rnContext (ksig_doc tycon) context
830 ; returnM (TyData {tcdND = tcdND tydecl, tcdCtxt = context',
831 tcdLName = tycon', tcdTyVars = tyvars',
832 tcdTyPats = Nothing, tcdKindSig = sig,
833 tcdCons = [], tcdDerivs = Nothing},
834 delFVs (map hsLTyVarName tyvars') $
835 extractHsCtxtTyNames context')
839 rnTySig (tydecl@TyFunction {tcdLName = tycon, tcdTyVars = tyvars,
842 do { checkM (not . null $ tyvars) $ addErr needOneIdx -- #indexes >= 1
843 ; bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
844 ; tycon' <- lookupLocatedTopBndrRn tycon
845 ; returnM (TyFunction {tcdLName = tycon', tcdTyVars = tyvars',
846 tcdIso = tcdIso tydecl, tcdKind = sig},
850 ksig_doc tycon = text "In the kind signature for" <+> quotes (ppr tycon)
851 needOneIdx = text "Kind signature requires at least one type index"
853 -- Rename associated type declarations (in classes)
855 -- * This can be kind signatures and (default) type function equations.
857 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
858 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
860 rn_at (tydecl@TyData {}) = rnTySig tydecl lookupIdxVars
861 rn_at (tydecl@TyFunction {}) = rnTySig tydecl lookupIdxVars
862 rn_at (tydecl@TySynonym {}) =
864 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
866 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
868 lookupIdxVars _ tyvars cont =
869 do { checkForDups tyvars;
870 ; tyvars' <- mappM lookupIdxVar tyvars
873 -- Type index variables must be class parameters, which are the only
874 -- type variables in scope at this point.
875 lookupIdxVar (L l tyvar) =
877 name' <- lookupOccRn (hsTyVarName tyvar)
878 return $ L l (replaceTyVarName tyvar name')
880 -- Type variable may only occur once.
882 checkForDups [] = return ()
883 checkForDups (L loc tv:ltvs) =
884 do { setSrcSpan loc $
885 when (hsTyVarName tv `ltvElem` ltvs) $
886 addErr (repeatedTyVar tv)
890 rdrName `ltvElem` [] = False
891 rdrName `ltvElem` (L _ tv:ltvs)
892 | rdrName == hsTyVarName tv = True
893 | otherwise = rdrName `ltvElem` ltvs
895 noPatterns = text "Default definition for an associated synonym cannot have"
896 <+> text "type pattern"
898 repeatedTyVar tv = ptext SLIT("Illegal repeated type variable") <+>
901 -- This data decl will parse OK
903 -- treating "a" as the constructor.
904 -- It is really hard to make the parser spot this malformation.
905 -- So the renamer has to check that the constructor is legal
907 -- We can get an operator as the constructor, even in the prefix form:
908 -- data T = :% Int Int
909 -- from interface files, which always print in prefix form
911 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
914 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
918 %*********************************************************
920 \subsection{Support code to rename types}
922 %*********************************************************
925 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
928 = mappM (wrapLocM rn_fds) fds
931 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
932 rnHsTyVars doc tys2 `thenM` \ tys2' ->
933 returnM (tys1', tys2')
935 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
936 rnHsTyvar doc tyvar = lookupOccRn tyvar
940 %*********************************************************
944 %*********************************************************
950 h = ...$(thing "f")...
952 The splice can expand into literally anything, so when we do dependency
953 analysis we must assume that it might mention 'f'. So we simply treat
954 all locally-defined names as mentioned by any splice. This is terribly
955 brutal, but I don't see what else to do. For example, it'll mean
956 that every locally-defined thing will appear to be used, so no unused-binding
957 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
958 and that will crash the type checker because 'f' isn't in scope.
960 Currently, I'm not treating a splice as also mentioning every import,
961 which is a bit inconsistent -- but there are a lot of them. We might
962 thereby get some bogus unused-import warnings, but we won't crash the
963 type checker. Not very satisfactory really.
966 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
967 rnSplice (HsSplice n expr)
968 = do { checkTH expr "splice"
970 ; [n'] <- newLocalsRn [L loc n]
971 ; (expr', fvs) <- rnLExpr expr
973 -- Ugh! See Note [Splices] above
974 ; lcl_rdr <- getLocalRdrEnv
975 ; gbl_rdr <- getGlobalRdrEnv
976 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
978 lcl_names = mkNameSet (occEnvElts lcl_rdr)
980 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
983 checkTH e what = returnM () -- OK
985 checkTH e what -- Raise an error in a stage-1 compiler
986 = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
987 ptext SLIT("illegal in a stage-1 compiler"),