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 -- At this point, stop if we have found errors. Otherwise
118 -- the rnDocEntity stuff reports the errors again.
121 rn_docs <- mapM rnDocEntity docs ;
124 rn_group = HsGroup { hs_valds = rn_val_decls,
125 hs_tyclds = rn_tycl_decls,
126 hs_instds = rn_inst_decls,
127 hs_derivds = rn_deriv_decls,
128 hs_fixds = rn_fix_decls,
130 hs_fords = rn_foreign_decls,
131 hs_defds = rn_default_decls,
132 hs_ruleds = rn_rule_decls,
133 hs_docs = rn_docs } ;
135 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs_deriv, src_fvs3,
136 src_fvs4, src_fvs5] ;
137 src_dus = bind_dus `plusDU` usesOnly other_fvs
138 -- Note: src_dus will contain *uses* for locally-defined types
139 -- and classes, but no *defs* for them. (Because rnTyClDecl
140 -- returns only the uses.) This is a little
141 -- surprising but it doesn't actually matter at all.
144 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
145 traceRn (text "finish Dus" <+> ppr src_dus ) ;
146 tcg_env <- getGblEnv ;
147 return (tcg_env `addTcgDUs` src_dus, rn_group)
150 rnDocEntity :: DocEntity RdrName -> RnM (DocEntity Name)
151 rnDocEntity (DocEntity docdecl) = do
152 rn_docdecl <- rnDocDecl docdecl
153 return (DocEntity rn_docdecl)
154 rnDocEntity (DeclEntity name) = do
155 rn_name <- lookupTopBndrRn name
156 return (DeclEntity rn_name)
158 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
159 rnDocDecl (DocCommentNext doc) = do
160 rn_doc <- rnHsDoc doc
161 return (DocCommentNext rn_doc)
162 rnDocDecl (DocCommentPrev doc) = do
163 rn_doc <- rnHsDoc doc
164 return (DocCommentPrev rn_doc)
165 rnDocDecl (DocCommentNamed str doc) = do
166 rn_doc <- rnHsDoc doc
167 return (DocCommentNamed str rn_doc)
168 rnDocDecl (DocGroup lev doc) = do
169 rn_doc <- rnHsDoc doc
170 return (DocGroup lev rn_doc)
172 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
173 rnTyClDecls tycl_decls = do
174 (decls', fvs) <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls
177 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
178 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
182 %*********************************************************
184 Source-code fixity declarations
186 %*********************************************************
189 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
190 rnSrcFixityDecls fix_decls
191 = do fix_decls <- mapM rnFixityDecl fix_decls
192 return (concat fix_decls)
194 rnFixityDecl :: LFixitySig RdrName -> RnM [LFixitySig Name]
195 rnFixityDecl (L loc (FixitySig (L nameLoc rdr_name) fixity))
196 = setSrcSpan nameLoc $
197 -- GHC extension: look up both the tycon and data con
198 -- for con-like things
199 -- If neither are in scope, report an error; otherwise
200 -- add both to the fixity env
201 do names <- lookupLocalDataTcNames rdr_name
202 return [ L loc (FixitySig (L nameLoc name) fixity)
205 rnSrcFixityDeclsEnv :: [LFixitySig Name] -> RnM FixityEnv
206 rnSrcFixityDeclsEnv fix_decls
207 = getGblEnv `thenM` \ gbl_env ->
208 foldlM rnFixityDeclEnv (tcg_fix_env gbl_env)
209 fix_decls `thenM` \ fix_env ->
210 traceRn (text "fixity env" <+> pprFixEnv fix_env) `thenM_`
213 rnFixityDeclEnv :: FixityEnv -> LFixitySig Name -> RnM FixityEnv
214 rnFixityDeclEnv fix_env (L loc (FixitySig (L nameLoc name) fixity))
215 = case lookupNameEnv fix_env name of
216 Just (FixItem _ _ loc')
217 -> do addLocErr (L nameLoc name) (dupFixityDecl loc')
220 -> return (extendNameEnv fix_env name fix_item)
221 where fix_item = FixItem (nameOccName name) fixity nameLoc
223 pprFixEnv :: FixityEnv -> SDoc
225 = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
228 dupFixityDecl loc rdr_name
229 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
230 ptext SLIT("also at ") <+> ppr loc
235 %*********************************************************
237 Source-code deprecations declarations
239 %*********************************************************
241 For deprecations, all we do is check that the names are in scope.
242 It's only imported deprecations, dealt with in RnIfaces, that we
243 gather them together.
246 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
250 rnSrcDeprecDecls decls
251 = mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
252 returnM (DeprecSome (mkNameEnv (concat pairs_s)))
254 rn_deprec (Deprecation rdr_name txt)
255 = lookupLocalDataTcNames rdr_name `thenM` \ names ->
256 returnM [(name, (nameOccName name, txt)) | name <- names]
258 checkModDeprec :: Maybe DeprecTxt -> Deprecations
259 -- Check for a module deprecation; done once at top level
260 checkModDeprec Nothing = NoDeprecs
261 checkModDeprec (Just txt) = DeprecAll txt
264 %*********************************************************
266 \subsection{Source code declarations}
268 %*********************************************************
271 rnDefaultDecl (DefaultDecl tys)
272 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
273 returnM (DefaultDecl tys', fvs)
275 doc_str = text "In a `default' declaration"
278 %*********************************************************
280 \subsection{Foreign declarations}
282 %*********************************************************
285 rnHsForeignDecl (ForeignImport name ty spec)
286 = lookupLocatedTopBndrRn name `thenM` \ name' ->
287 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
288 returnM (ForeignImport name' ty' spec, fvs)
290 rnHsForeignDecl (ForeignExport name ty spec)
291 = lookupLocatedOccRn name `thenM` \ name' ->
292 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
293 returnM (ForeignExport name' ty' spec, fvs )
294 -- NB: a foreign export is an *occurrence site* for name, so
295 -- we add it to the free-variable list. It might, for example,
296 -- be imported from another module
298 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
302 %*********************************************************
304 \subsection{Instance declarations}
306 %*********************************************************
309 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
310 -- Used for both source and interface file decls
311 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
313 -- Rename the associated types
314 -- The typechecker (not the renamer) checks that all
315 -- the declarations are for the right class
317 at_doc = text "In the associated types of an instance declaration"
318 at_names = map (head . tyClDeclNames . unLoc) ats
320 checkDupNames at_doc at_names `thenM_`
321 rnATInsts ats `thenM` \ (ats', at_fvs) ->
323 -- Rename the bindings
324 -- The typechecker (not the renamer) checks that all
325 -- the bindings are for the right class
327 meth_doc = text "In the bindings in an instance declaration"
328 meth_names = collectHsBindLocatedBinders mbinds
329 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
331 checkDupNames meth_doc meth_names `thenM_`
332 extendTyVarEnvForMethodBinds inst_tyvars (
333 -- (Slightly strangely) the forall-d tyvars scope over
334 -- the method bindings too
335 rnMethodBinds cls (\n->[]) -- No scoped tyvars
337 ) `thenM` \ (mbinds', meth_fvs) ->
338 -- Rename the prags and signatures.
339 -- Note that the type variables are not in scope here,
340 -- so that instance Eq a => Eq (T a) where
341 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
344 -- But the (unqualified) method names are in scope
346 binders = collectHsBindBinders mbinds'
347 ok_sig = okInstDclSig (mkNameSet binders)
349 bindLocalNames binders (renameSigs ok_sig uprags) `thenM` \ uprags' ->
351 returnM (InstDecl inst_ty' mbinds' uprags' ats',
352 meth_fvs `plusFV` at_fvs
353 `plusFV` hsSigsFVs uprags'
354 `plusFV` extractHsTyNames inst_ty')
355 -- We return the renamed associated data type declarations so
356 -- that they can be entered into the list of type declarations
357 -- for the binding group, but we also keep a copy in the instance.
358 -- The latter is needed for well-formedness checks in the type
359 -- checker (eg, to ensure that all ATs of the instance actually
360 -- receive a declaration).
361 -- NB: Even the copies in the instance declaration carry copies of
362 -- the instance context after renaming. This is a bit
363 -- strange, but should not matter (and it would be more work
364 -- to remove the context).
367 Renaming of the associated types in instances.
369 * We raise an error if we encounter a kind signature in an instance.
372 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
374 mapFvRn (wrapLocFstM rnATInst) atDecls
376 rnATInst tydecl@TyFunction {} =
380 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
381 rnATInst tydecl@TyData {} =
383 checkM (not . isKindSigDecl $ tydecl) $ addErr noKindSig
386 panic "RnSource.rnATInsts: not a type declaration"
388 noKindSig = text "Instances cannot have kind signatures"
391 For the method bindings in class and instance decls, we extend the
392 type variable environment iff -fglasgow-exts
395 extendTyVarEnvForMethodBinds tyvars thing_inside
396 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
397 if opt_GlasgowExts then
398 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
403 %*********************************************************
405 \subsection{Stand-alone deriving declarations}
407 %*********************************************************
410 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
411 rnSrcDerivDecl (DerivDecl ty n)
412 = do ty' <- rnLHsType (text "a deriving decl") ty
413 n' <- lookupLocatedOccRn n
414 let fvs = extractHsTyNames ty' `addOneFV` unLoc n'
415 return (DerivDecl ty' n', fvs)
418 %*********************************************************
422 %*********************************************************
425 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
426 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
428 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
429 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
431 rnLExpr lhs `thenM` \ (lhs', fv_lhs') ->
432 rnLExpr rhs `thenM` \ (rhs', fv_rhs') ->
434 checkValidRule rule_name ids lhs' fv_lhs' `thenM_`
436 returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
437 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
439 doc = text "In the transformation rule" <+> ftext rule_name
441 get_var (RuleBndr v) = v
442 get_var (RuleBndrSig v _) = v
444 rn_var (RuleBndr (L loc v), id)
445 = returnM (RuleBndr (L loc id), emptyFVs)
446 rn_var (RuleBndrSig (L loc v) t, id)
447 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
448 returnM (RuleBndrSig (L loc id) t', fvs)
451 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
452 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
453 ptext SLIT("does not appear on left hand side")]
456 Note [Rule LHS validity checking]
457 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
458 Check the shape of a transformation rule LHS. Currently we only allow
459 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
460 @forall@'d variables.
462 We used restrict the form of the 'ei' to prevent you writing rules
463 with LHSs with a complicated desugaring (and hence unlikely to match);
464 (e.g. a case expression is not allowed: too elaborate.)
466 But there are legitimate non-trivial args ei, like sections and
467 lambdas. So it seems simmpler not to check at all, and that is why
468 check_e is commented out.
471 checkValidRule rule_name ids lhs' fv_lhs'
472 = do { -- Check for the form of the LHS
473 case (validRuleLhs ids lhs') of
475 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
477 -- Check that LHS vars are all bound
478 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
479 ; mappM (addErr . badRuleVar rule_name) bad_vars }
481 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
483 -- Just e => Not ok, and e is the offending expression
484 validRuleLhs foralls lhs
487 checkl (L loc e) = check e
489 check (OpApp e1 op _ e2) = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
490 check (HsApp e1 e2) = checkl e1 `seqMaybe` checkl_e e2
491 check (HsVar v) | v `notElem` foralls = Nothing
492 check other = Just other -- Failure
495 checkl_e (L loc e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
497 {- Commented out; see Note [Rule LHS validity checking] above
498 check_e (HsVar v) = Nothing
499 check_e (HsPar e) = checkl_e e
500 check_e (HsLit e) = Nothing
501 check_e (HsOverLit e) = Nothing
503 check_e (OpApp e1 op _ e2) = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
504 check_e (HsApp e1 e2) = checkl_e e1 `seqMaybe` checkl_e e2
505 check_e (NegApp e _) = checkl_e e
506 check_e (ExplicitList _ es) = checkl_es es
507 check_e (ExplicitTuple es _) = checkl_es es
508 check_e other = Just other -- Fails
510 checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
513 badRuleLhsErr name lhs bad_e
514 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
515 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
516 ptext SLIT("in left-hand side:") <+> ppr lhs])]
518 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
522 %*********************************************************
524 \subsection{Type, class and iface sig declarations}
526 %*********************************************************
528 @rnTyDecl@ uses the `global name function' to create a new type
529 declaration in which local names have been replaced by their original
530 names, reporting any unknown names.
532 Renaming type variables is a pain. Because they now contain uniques,
533 it is necessary to pass in an association list which maps a parsed
534 tyvar to its @Name@ representation.
535 In some cases (type signatures of values),
536 it is even necessary to go over the type first
537 in order to get the set of tyvars used by it, make an assoc list,
538 and then go over it again to rename the tyvars!
539 However, we can also do some scoping checks at the same time.
542 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
543 = lookupLocatedTopBndrRn name `thenM` \ name' ->
544 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
547 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
548 tcdLName = tycon, tcdTyVars = tyvars,
549 tcdTyPats = typatsMaybe, tcdCons = condecls,
550 tcdKindSig = sig, tcdDerivs = derivs})
551 | isKindSigDecl tydecl -- kind signature of indexed type
552 = rnTySig tydecl bindTyVarsRn
553 | is_vanilla -- Normal Haskell data type decl
554 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
555 -- data type is syntactically illegal
556 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
557 do { tycon' <- if isIdxTyDecl tydecl
558 then lookupLocatedOccRn tycon -- may be imported family
559 else lookupLocatedTopBndrRn tycon
560 ; context' <- rnContext data_doc context
561 ; typats' <- rnTyPats data_doc typatsMaybe
562 ; (derivs', deriv_fvs) <- rn_derivs derivs
563 ; checkDupNames data_doc con_names
564 ; condecls' <- rnConDecls (unLoc tycon') condecls
565 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
566 tcdLName = tycon', tcdTyVars = tyvars',
567 tcdTyPats = typats', tcdKindSig = Nothing,
568 tcdCons = condecls', tcdDerivs = derivs'},
569 delFVs (map hsLTyVarName tyvars') $
570 extractHsCtxtTyNames context' `plusFV`
571 plusFVs (map conDeclFVs condecls') `plusFV`
573 (if isIdxTyDecl tydecl
574 then unitFV (unLoc tycon') -- type instance => use
579 = ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
580 do { tycon' <- if isIdxTyDecl tydecl
581 then lookupLocatedOccRn tycon -- may be imported family
582 else lookupLocatedTopBndrRn tycon
583 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
584 ; tyvars' <- bindTyVarsRn data_doc tyvars
585 (\ tyvars' -> return tyvars')
586 -- For GADTs, the type variables in the declaration
587 -- do not scope over the constructor signatures
588 -- data T a where { T1 :: forall b. b-> b }
589 ; (derivs', deriv_fvs) <- rn_derivs derivs
590 ; checkDupNames data_doc con_names
591 ; condecls' <- rnConDecls (unLoc tycon') condecls
592 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
593 tcdLName = tycon', tcdTyVars = tyvars',
594 tcdTyPats = Nothing, tcdKindSig = sig,
595 tcdCons = condecls', tcdDerivs = derivs'},
596 plusFVs (map conDeclFVs condecls') `plusFV`
598 (if isIdxTyDecl tydecl
599 then unitFV (unLoc tycon') -- type instance => use
603 is_vanilla = case condecls of -- Yuk
605 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
609 none (Just []) = True
612 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
613 con_names = map con_names_helper condecls
615 con_names_helper (L _ c) = con_name c
617 rn_derivs Nothing = returnM (Nothing, emptyFVs)
618 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
619 returnM (Just ds', extractHsTyNames_s ds')
621 rnTyClDecl (tydecl@TyFunction {}) =
622 rnTySig tydecl bindTyVarsRn
624 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
625 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
626 = bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
627 do { name' <- if isIdxTyDecl tydecl
628 then lookupLocatedOccRn name -- may be imported family
629 else lookupLocatedTopBndrRn name
630 ; typats' <- rnTyPats syn_doc typatsMaybe
631 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
632 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
633 tcdTyPats = typats', tcdSynRhs = ty'},
634 delFVs (map hsLTyVarName tyvars') $
636 (if isIdxTyDecl tydecl
637 then unitFV (unLoc name') -- type instance => use
641 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
643 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
644 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
645 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
646 = lookupLocatedTopBndrRn cname `thenM` \ cname' ->
648 -- Tyvars scope over superclass context and method signatures
649 bindTyVarsRn cls_doc tyvars ( \ tyvars' ->
650 rnContext cls_doc context `thenM` \ context' ->
651 rnFds cls_doc fds `thenM` \ fds' ->
652 rnATs ats `thenM` \ (ats', ats_fvs) ->
653 renameSigs okClsDclSig sigs `thenM` \ sigs' ->
654 mapM rnDocEntity docs `thenM` \ docs' ->
655 returnM (tyvars', context', fds', (ats', ats_fvs), sigs', docs')
656 ) `thenM` \ (tyvars', context', fds', (ats', ats_fvs), sigs', docs') ->
658 -- Check for duplicates among the associated types
660 at_rdr_names_w_locs = [tcdLName ty | L _ ty <- ats]
662 checkDupNames at_doc at_rdr_names_w_locs `thenM_`
664 -- Check the signatures
665 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
667 sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
669 checkDupNames sig_doc sig_rdr_names_w_locs `thenM_`
670 -- Typechecker is responsible for checking that we only
671 -- give default-method bindings for things in this class.
672 -- The renamer *could* check this for class decls, but can't
673 -- for instance decls.
675 -- The newLocals call is tiresome: given a generic class decl
678 -- op {| x+y |} (Inl a) = ...
679 -- op {| x+y |} (Inr b) = ...
680 -- op {| a*b |} (a*b) = ...
681 -- we want to name both "x" tyvars with the same unique, so that they are
682 -- easy to group together in the typechecker.
683 extendTyVarEnvForMethodBinds tyvars' (
684 getLocalRdrEnv `thenM` \ name_env ->
686 meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
687 gen_rdr_tyvars_w_locs =
688 [ tv | tv <- extractGenericPatTyVars mbinds,
689 not (unLoc tv `elemLocalRdrEnv` name_env) ]
691 checkDupNames meth_doc meth_rdr_names_w_locs `thenM_`
692 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
693 rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds
694 ) `thenM` \ (mbinds', meth_fvs) ->
696 returnM (ClassDecl { tcdCtxt = context', tcdLName = cname',
697 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
698 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
699 delFVs (map hsLTyVarName tyvars') $
700 extractHsCtxtTyNames context' `plusFV`
701 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
702 hsSigsFVs sigs' `plusFV`
706 meth_doc = text "In the default-methods for class" <+> ppr cname
707 cls_doc = text "In the declaration for class" <+> ppr cname
708 sig_doc = text "In the signatures for class" <+> ppr cname
709 at_doc = text "In the associated types for class" <+> ppr cname
711 badGadtStupidTheta tycon
712 = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
713 ptext SLIT("(You can put a context on each contructor, though.)")]
716 %*********************************************************
718 \subsection{Support code for type/data declarations}
720 %*********************************************************
723 -- Although, we are processing type patterns here, all type variables will
724 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
725 -- type declaration to which these patterns belong)
727 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
728 rnTyPats _ Nothing = return Nothing
729 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
731 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
732 rnConDecls tycon condecls
733 = mappM (wrapLocM rnConDecl) condecls
735 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
736 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
737 = do { addLocM checkConName name
739 ; new_name <- lookupLocatedTopBndrRn name
740 ; name_env <- getLocalRdrEnv
742 -- For H98 syntax, the tvs are the existential ones
743 -- For GADT syntax, the tvs are all the quantified tyvars
744 -- Hence the 'filter' in the ResTyH98 case only
745 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
746 arg_tys = hsConArgs details
747 implicit_tvs = case res_ty of
748 ResTyH98 -> filter not_in_scope $
750 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
753 Implicit -> userHsTyVarBndrs implicit_tvs
755 ; mb_doc' <- rnMbLHsDoc mb_doc
757 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
758 { new_context <- rnContext doc cxt
759 ; new_details <- rnConDetails doc details
760 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
761 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
763 doc = text "In the definition of data constructor" <+> quotes (ppr name)
764 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
766 rnConResult _ details ResTyH98 = return (details, ResTyH98)
768 rnConResult doc details (ResTyGADT ty) = do
769 ty' <- rnHsSigType doc ty
770 let (arg_tys, res_ty) = splitHsFunType ty'
771 -- We can split it up, now the renamer has dealt with fixities
773 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
774 RecCon fields -> return (details, ResTyGADT ty')
775 InfixCon {} -> panic "rnConResult"
777 rnConDetails doc (PrefixCon tys)
778 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
779 returnM (PrefixCon new_tys)
781 rnConDetails doc (InfixCon ty1 ty2)
782 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
783 rnLHsType doc ty2 `thenM` \ new_ty2 ->
784 returnM (InfixCon new_ty1 new_ty2)
786 rnConDetails doc (RecCon fields)
787 = checkDupNames doc field_names `thenM_`
788 mappM (rnField doc) fields `thenM` \ new_fields ->
789 returnM (RecCon new_fields)
791 field_names = [ name | HsRecField name _ _ <- fields ]
793 -- Document comments are renamed to Nothing here
794 rnField doc (HsRecField name ty haddock_doc)
795 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
796 rnLHsType doc ty `thenM` \ new_ty ->
797 rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
798 returnM (HsRecField new_name new_ty new_haddock_doc)
800 -- Rename kind signatures (signatures of indexed data types/newtypes and
801 -- signatures of type functions)
803 -- * This function is parametrised by the routine handling the index
804 -- variables. On the toplevel, these are defining occurences, whereas they
805 -- are usage occurences for associated types.
807 rnTySig :: TyClDecl RdrName
808 -> (SDoc -> [LHsTyVarBndr RdrName] ->
809 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
810 RnM (TyClDecl Name, FreeVars))
811 -> RnM (TyClDecl Name, FreeVars)
813 rnTySig (tydecl@TyData {tcdCtxt = context, tcdLName = tycon,
814 tcdTyVars = tyvars, tcdTyPats = mb_typats,
815 tcdCons = condecls, tcdKindSig = sig,
818 ASSERT( null condecls ) -- won't have constructors
819 ASSERT( isNothing mb_typats ) -- won't have type patterns
820 ASSERT( isNothing derivs ) -- won't have deriving
821 ASSERT( isJust sig ) -- will have kind signature
822 do { checkM (not . null $ tyvars) $ addErr needOneIdx -- #indexes >= 1
823 ; bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
824 ; tycon' <- lookupLocatedTopBndrRn tycon
825 ; context' <- rnContext (ksig_doc tycon) context
826 ; returnM (TyData {tcdND = tcdND tydecl, tcdCtxt = context',
827 tcdLName = tycon', tcdTyVars = tyvars',
828 tcdTyPats = Nothing, tcdKindSig = sig,
829 tcdCons = [], tcdDerivs = Nothing},
830 delFVs (map hsLTyVarName tyvars') $
831 extractHsCtxtTyNames context')
835 rnTySig (tydecl@TyFunction {tcdLName = tycon, tcdTyVars = tyvars,
838 do { checkM (not . null $ tyvars) $ addErr needOneIdx -- #indexes >= 1
839 ; bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
840 ; tycon' <- lookupLocatedTopBndrRn tycon
841 ; returnM (TyFunction {tcdLName = tycon', tcdTyVars = tyvars',
842 tcdIso = tcdIso tydecl, tcdKind = sig},
846 ksig_doc tycon = text "In the kind signature for" <+> quotes (ppr tycon)
847 needOneIdx = text "Kind signature requires at least one type index"
849 -- Rename associated type declarations (in classes)
851 -- * This can be kind signatures and (default) type function equations.
853 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
854 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
856 rn_at (tydecl@TyData {}) = rnTySig tydecl lookupIdxVars
857 rn_at (tydecl@TyFunction {}) = rnTySig tydecl lookupIdxVars
858 rn_at (tydecl@TySynonym {}) =
860 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
862 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
864 lookupIdxVars _ tyvars cont =
865 do { checkForDups tyvars;
866 ; tyvars' <- mappM lookupIdxVar tyvars
869 -- Type index variables must be class parameters, which are the only
870 -- type variables in scope at this point.
871 lookupIdxVar (L l tyvar) =
873 name' <- lookupOccRn (hsTyVarName tyvar)
874 return $ L l (replaceTyVarName tyvar name')
876 -- Type variable may only occur once.
878 checkForDups [] = return ()
879 checkForDups (L loc tv:ltvs) =
880 do { setSrcSpan loc $
881 when (hsTyVarName tv `ltvElem` ltvs) $
882 addErr (repeatedTyVar tv)
886 rdrName `ltvElem` [] = False
887 rdrName `ltvElem` (L _ tv:ltvs)
888 | rdrName == hsTyVarName tv = True
889 | otherwise = rdrName `ltvElem` ltvs
891 noPatterns = text "Default definition for an associated synonym cannot have"
892 <+> text "type pattern"
894 repeatedTyVar tv = ptext SLIT("Illegal repeated type variable") <+>
897 -- This data decl will parse OK
899 -- treating "a" as the constructor.
900 -- It is really hard to make the parser spot this malformation.
901 -- So the renamer has to check that the constructor is legal
903 -- We can get an operator as the constructor, even in the prefix form:
904 -- data T = :% Int Int
905 -- from interface files, which always print in prefix form
907 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
910 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
914 %*********************************************************
916 \subsection{Support code to rename types}
918 %*********************************************************
921 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
924 = mappM (wrapLocM rn_fds) fds
927 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
928 rnHsTyVars doc tys2 `thenM` \ tys2' ->
929 returnM (tys1', tys2')
931 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
932 rnHsTyvar doc tyvar = lookupOccRn tyvar
936 %*********************************************************
940 %*********************************************************
946 h = ...$(thing "f")...
948 The splice can expand into literally anything, so when we do dependency
949 analysis we must assume that it might mention 'f'. So we simply treat
950 all locally-defined names as mentioned by any splice. This is terribly
951 brutal, but I don't see what else to do. For example, it'll mean
952 that every locally-defined thing will appear to be used, so no unused-binding
953 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
954 and that will crash the type checker because 'f' isn't in scope.
956 Currently, I'm not treating a splice as also mentioning every import,
957 which is a bit inconsistent -- but there are a lot of them. We might
958 thereby get some bogus unused-import warnings, but we won't crash the
959 type checker. Not very satisfactory really.
962 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
963 rnSplice (HsSplice n expr)
964 = do { checkTH expr "splice"
966 ; [n'] <- newLocalsRn [L loc n]
967 ; (expr', fvs) <- rnLExpr expr
969 -- Ugh! See Note [Splices] above
970 ; lcl_rdr <- getLocalRdrEnv
971 ; gbl_rdr <- getGlobalRdrEnv
972 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
974 lcl_names = mkNameSet (occEnvElts lcl_rdr)
976 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
979 checkTH e what = returnM () -- OK
981 checkTH e what -- Raise an error in a stage-1 compiler
982 = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
983 ptext SLIT("illegal in a stage-1 compiler"),