2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
13 #include "HsVersions.h"
15 import {-# SOURCE #-} RnExpr( rnLExpr )
18 import RdrName ( RdrName, isRdrDataCon, elemLocalRdrEnv,
19 globalRdrEnvElts, GlobalRdrElt(..), isLocalGRE )
20 import RdrHsSyn ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
22 import RnTypes ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
23 import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs, mkSigTvFn )
24 import RnEnv ( lookupLocalDataTcNames,
25 lookupLocatedTopBndrRn, lookupLocatedOccRn,
26 lookupOccRn, newLocalsRn,
27 bindLocatedLocalsFV, bindPatSigTyVarsFV,
28 bindTyVarsRn, extendTyVarEnvFVRn,
29 bindLocalNames, checkDupNames, mapFvRn
31 import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
34 import HscTypes ( FixityEnv, FixItem(..), Deprecations, Deprecs(..), plusDeprecs )
35 import Class ( FunDep )
36 import Name ( Name, nameOccName )
39 import OccName ( occEnvElts )
41 import SrcLoc ( Located(..), unLoc, noLoc )
42 import DynFlags ( DynFlag(..) )
43 import Maybes ( seqMaybe )
44 import Maybe ( isNothing )
45 import Monad ( liftM, when )
46 import BasicTypes ( Boxity(..) )
49 @rnSourceDecl@ `renames' declarations.
50 It simultaneously performs dependency analysis and precedence parsing.
51 It also does the following error checks:
54 Checks that tyvars are used properly. This includes checking
55 for undefined tyvars, and tyvars in contexts that are ambiguous.
56 (Some of this checking has now been moved to module @TcMonoType@,
57 since we don't have functional dependency information at this point.)
59 Checks that all variable occurences are defined.
61 Checks the @(..)@ etc constraints in the export list.
66 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
68 rnSrcDecls (HsGroup { hs_valds = val_decls,
69 hs_tyclds = tycl_decls,
70 hs_instds = inst_decls,
71 hs_derivds = deriv_decls,
73 hs_depds = deprec_decls,
74 hs_fords = foreign_decls,
75 hs_defds = default_decls,
76 hs_ruleds = rule_decls,
79 = do { -- Deal with deprecations (returns only the extra deprecations)
80 deprecs <- rnSrcDeprecDecls deprec_decls ;
81 updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
84 -- Deal with top-level fixity decls
85 -- (returns the total new fixity env)
86 rn_fix_decls <- rnSrcFixityDecls fix_decls ;
87 tcg_env <- extendGblFixityEnv rn_fix_decls ;
88 setGblEnv tcg_env $ do {
90 -- Rename type and class decls
91 -- You might think that we could build proper def/use information
92 -- for type and class declarations, but they can be involved
93 -- in mutual recursion across modules, and we only do the SCC
94 -- analysis for them in the type checker.
95 -- So we content ourselves with gathering uses only; that
96 -- means we'll only report a declaration as unused if it isn't
97 -- mentioned at all. Ah well.
98 traceRn (text "Start rnTyClDecls") ;
99 (rn_tycl_decls, src_fvs1) <- rnList rnTyClDecl tycl_decls ;
101 -- Extract the mapping from data constructors to field names
102 tcg_env <- extendRecordFieldEnv rn_tycl_decls ;
103 setGblEnv tcg_env $ do {
105 -- Value declarations
106 traceRn (text "Start rnmono") ;
107 (rn_val_decls, bind_dus) <- rnTopBinds val_decls ;
108 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
111 (rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ;
112 (rn_rule_decls, src_fvs3) <- rnList rnHsRuleDecl rule_decls ;
113 (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
114 (rn_default_decls, src_fvs5) <- rnList rnDefaultDecl default_decls ;
115 (rn_deriv_decls, src_fvs6) <- rnList rnSrcDerivDecl deriv_decls ;
117 -- Haddock docs; no free vars
118 rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
121 rn_group = HsGroup { hs_valds = rn_val_decls,
122 hs_tyclds = rn_tycl_decls,
123 hs_instds = rn_inst_decls,
124 hs_derivds = rn_deriv_decls,
125 hs_fixds = rn_fix_decls,
127 hs_fords = rn_foreign_decls,
128 hs_defds = rn_default_decls,
129 hs_ruleds = rn_rule_decls,
130 hs_docs = rn_docs } ;
132 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs6, src_fvs3,
133 src_fvs4, src_fvs5] ;
134 src_dus = bind_dus `plusDU` usesOnly other_fvs
135 -- Note: src_dus will contain *uses* for locally-defined types
136 -- and classes, but no *defs* for them. (Because rnTyClDecl
137 -- returns only the uses.) This is a little
138 -- surprising but it doesn't actually matter at all.
141 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
142 traceRn (text "finish Dus" <+> ppr src_dus ) ;
143 return (tcg_env `addTcgDUs` src_dus, rn_group)
146 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
147 -- Used for external core
148 rnTyClDecls tycl_decls = do (decls', fvs) <- rnList rnTyClDecl tycl_decls
151 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
152 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
154 rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
155 rnList f xs = mapFvRn (wrapLocFstM f) xs
159 %*********************************************************
163 %*********************************************************
166 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
167 rnDocDecl (DocCommentNext doc) = do
168 rn_doc <- rnHsDoc doc
169 return (DocCommentNext rn_doc)
170 rnDocDecl (DocCommentPrev doc) = do
171 rn_doc <- rnHsDoc doc
172 return (DocCommentPrev rn_doc)
173 rnDocDecl (DocCommentNamed str doc) = do
174 rn_doc <- rnHsDoc doc
175 return (DocCommentNamed str rn_doc)
176 rnDocDecl (DocGroup lev doc) = do
177 rn_doc <- rnHsDoc doc
178 return (DocGroup lev rn_doc)
182 %*********************************************************
184 Source-code fixity declarations
186 %*********************************************************
189 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
190 -- First rename the fixity decls, so we can put
191 -- the renamed decls in the renamed syntax tre
192 rnSrcFixityDecls fix_decls
193 = do fix_decls <- mapM rn_decl fix_decls
194 return (concat fix_decls)
196 rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
197 -- GHC extension: look up both the tycon and data con
198 -- for con-like things; hence returning a list
199 -- If neither are in scope, report an error; otherwise
200 -- add both to the fixity env
201 rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
202 = setSrcSpan name_loc $
203 do names <- lookupLocalDataTcNames rdr_name
204 return [ L loc (FixitySig (L name_loc name) fixity)
207 extendGblFixityEnv :: [LFixitySig Name] -> RnM TcGblEnv
208 -- Extend the global envt with fixity decls, checking for duplicate decls
209 extendGblFixityEnv decls
210 = do { env <- getGblEnv
211 ; fix_env' <- foldlM add_one (tcg_fix_env env) decls
212 ; return (env { tcg_fix_env = fix_env' }) }
214 add_one fix_env (L loc (FixitySig (L name_loc name) fixity))
215 | Just (FixItem _ _ loc') <- lookupNameEnv fix_env name
216 = do { setSrcSpan loc $
217 addLocErr (L name_loc name) (dupFixityDecl loc')
220 = return (extendNameEnv fix_env name fix_item)
222 fix_item = FixItem (nameOccName name) fixity loc
224 pprFixEnv :: FixityEnv -> SDoc
226 = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
229 dupFixityDecl loc rdr_name
230 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
231 ptext SLIT("also at ") <+> ppr loc
236 %*********************************************************
238 Source-code deprecations declarations
240 %*********************************************************
242 For deprecations, all we do is check that the names are in scope.
243 It's only imported deprecations, dealt with in RnIfaces, that we
244 gather them together.
247 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
251 rnSrcDeprecDecls decls
252 = mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
253 returnM (DeprecSome (mkNameEnv (concat pairs_s)))
255 rn_deprec (Deprecation rdr_name txt)
256 = lookupLocalDataTcNames rdr_name `thenM` \ names ->
257 returnM [(name, (nameOccName name, txt)) | name <- names]
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 `addOneFV` unLoc name')
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.
366 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
367 rnATInsts atDecls = rnList rnATInst atDecls
369 rnATInst tydecl@TyData {} = rnTyClDecl tydecl
370 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
372 pprPanic "RnSource.rnATInsts: invalid AT instance"
373 (ppr (tcdName tydecl))
376 For the method bindings in class and instance decls, we extend the
377 type variable environment iff -fglasgow-exts
380 extendTyVarEnvForMethodBinds tyvars thing_inside
381 = do { scoped_tvs <- doptM Opt_ScopedTypeVariables
383 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
388 %*********************************************************
390 \subsection{Stand-alone deriving declarations}
392 %*********************************************************
395 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
396 rnSrcDerivDecl (DerivDecl ty)
397 = do ty' <- rnLHsType (text "a deriving decl") ty
398 let fvs = extractHsTyNames ty'
399 return (DerivDecl ty', fvs)
402 %*********************************************************
406 %*********************************************************
409 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
410 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
412 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
413 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
415 rnLExpr lhs `thenM` \ (lhs', fv_lhs') ->
416 rnLExpr rhs `thenM` \ (rhs', fv_rhs') ->
418 checkValidRule rule_name ids lhs' fv_lhs' `thenM_`
420 returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
421 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
423 doc = text "In the transformation rule" <+> ftext rule_name
425 get_var (RuleBndr v) = v
426 get_var (RuleBndrSig v _) = v
428 rn_var (RuleBndr (L loc v), id)
429 = returnM (RuleBndr (L loc id), emptyFVs)
430 rn_var (RuleBndrSig (L loc v) t, id)
431 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
432 returnM (RuleBndrSig (L loc id) t', fvs)
435 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
436 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
437 ptext SLIT("does not appear on left hand side")]
440 Note [Rule LHS validity checking]
441 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
442 Check the shape of a transformation rule LHS. Currently we only allow
443 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
444 @forall@'d variables.
446 We used restrict the form of the 'ei' to prevent you writing rules
447 with LHSs with a complicated desugaring (and hence unlikely to match);
448 (e.g. a case expression is not allowed: too elaborate.)
450 But there are legitimate non-trivial args ei, like sections and
451 lambdas. So it seems simmpler not to check at all, and that is why
452 check_e is commented out.
455 checkValidRule rule_name ids lhs' fv_lhs'
456 = do { -- Check for the form of the LHS
457 case (validRuleLhs ids lhs') of
459 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
461 -- Check that LHS vars are all bound
462 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
463 ; mappM (addErr . badRuleVar rule_name) bad_vars }
465 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
467 -- Just e => Not ok, and e is the offending expression
468 validRuleLhs foralls lhs
471 checkl (L loc e) = check e
473 check (OpApp e1 op _ e2) = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
474 check (HsApp e1 e2) = checkl e1 `seqMaybe` checkl_e e2
475 check (HsVar v) | v `notElem` foralls = Nothing
476 check other = Just other -- Failure
479 checkl_e (L loc e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
481 {- Commented out; see Note [Rule LHS validity checking] above
482 check_e (HsVar v) = Nothing
483 check_e (HsPar e) = checkl_e e
484 check_e (HsLit e) = Nothing
485 check_e (HsOverLit e) = Nothing
487 check_e (OpApp e1 op _ e2) = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
488 check_e (HsApp e1 e2) = checkl_e e1 `seqMaybe` checkl_e e2
489 check_e (NegApp e _) = checkl_e e
490 check_e (ExplicitList _ es) = checkl_es es
491 check_e (ExplicitTuple es _) = checkl_es es
492 check_e other = Just other -- Fails
494 checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
497 badRuleLhsErr name lhs bad_e
498 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
499 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
500 ptext SLIT("in left-hand side:") <+> ppr lhs])]
502 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
506 %*********************************************************
508 \subsection{Type, class and iface sig declarations}
510 %*********************************************************
512 @rnTyDecl@ uses the `global name function' to create a new type
513 declaration in which local names have been replaced by their original
514 names, reporting any unknown names.
516 Renaming type variables is a pain. Because they now contain uniques,
517 it is necessary to pass in an association list which maps a parsed
518 tyvar to its @Name@ representation.
519 In some cases (type signatures of values),
520 it is even necessary to go over the type first
521 in order to get the set of tyvars used by it, make an assoc list,
522 and then go over it again to rename the tyvars!
523 However, we can also do some scoping checks at the same time.
526 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
527 = lookupLocatedTopBndrRn name `thenM` \ name' ->
528 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
531 -- all flavours of type family declarations ("type family", "newtype fanily",
532 -- and "data family")
533 rnTyClDecl (tydecl@TyFamily {}) =
534 rnFamily tydecl bindTyVarsRn
536 -- "data", "newtype", "data instance, and "newtype instance" declarations
537 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
538 tcdLName = tycon, tcdTyVars = tyvars,
539 tcdTyPats = typatsMaybe, tcdCons = condecls,
540 tcdKindSig = sig, tcdDerivs = derivs})
541 | is_vanilla -- Normal Haskell data type decl
542 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
543 -- data type is syntactically illegal
544 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
545 do { tycon' <- if isFamInstDecl tydecl
546 then lookupLocatedOccRn tycon -- may be imported family
547 else lookupLocatedTopBndrRn tycon
548 ; context' <- rnContext data_doc context
549 ; typats' <- rnTyPats data_doc typatsMaybe
550 ; (derivs', deriv_fvs) <- rn_derivs derivs
551 ; checkDupNames data_doc con_names
552 ; condecls' <- rnConDecls (unLoc tycon') condecls
553 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
554 tcdLName = tycon', tcdTyVars = tyvars',
555 tcdTyPats = typats', tcdKindSig = Nothing,
556 tcdCons = condecls', tcdDerivs = derivs'},
557 delFVs (map hsLTyVarName tyvars') $
558 extractHsCtxtTyNames context' `plusFV`
559 plusFVs (map conDeclFVs condecls') `plusFV`
561 (if isFamInstDecl tydecl
562 then unitFV (unLoc tycon') -- type instance => use
567 = ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
568 do { tycon' <- if isFamInstDecl tydecl
569 then lookupLocatedOccRn tycon -- may be imported family
570 else lookupLocatedTopBndrRn tycon
571 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
572 ; tyvars' <- bindTyVarsRn data_doc tyvars
573 (\ tyvars' -> return tyvars')
574 -- For GADTs, the type variables in the declaration
575 -- do not scope over the constructor signatures
576 -- data T a where { T1 :: forall b. b-> b }
577 ; (derivs', deriv_fvs) <- rn_derivs derivs
578 ; checkDupNames data_doc con_names
579 ; condecls' <- rnConDecls (unLoc tycon') condecls
580 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
581 tcdLName = tycon', tcdTyVars = tyvars',
582 tcdTyPats = Nothing, tcdKindSig = sig,
583 tcdCons = condecls', tcdDerivs = derivs'},
584 plusFVs (map conDeclFVs condecls') `plusFV`
586 (if isFamInstDecl tydecl
587 then unitFV (unLoc tycon') -- type instance => use
591 is_vanilla = case condecls of -- Yuk
593 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
597 none (Just []) = True
600 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
601 con_names = map con_names_helper condecls
603 con_names_helper (L _ c) = con_name c
605 rn_derivs Nothing = returnM (Nothing, emptyFVs)
606 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
607 returnM (Just ds', extractHsTyNames_s ds')
609 -- "type" and "type instance" declarations
610 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
611 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
612 = bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
613 do { name' <- if isFamInstDecl tydecl
614 then lookupLocatedOccRn name -- may be imported family
615 else lookupLocatedTopBndrRn name
616 ; typats' <- rnTyPats syn_doc typatsMaybe
617 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
618 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
619 tcdTyPats = typats', tcdSynRhs = ty'},
620 delFVs (map hsLTyVarName tyvars') $
622 (if isFamInstDecl tydecl
623 then unitFV (unLoc name') -- type instance => use
627 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
629 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
630 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
631 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
632 = do { cname' <- lookupLocatedTopBndrRn cname
634 -- Tyvars scope over superclass context and method signatures
635 ; (tyvars', context', fds', ats', ats_fvs, sigs')
636 <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
637 { context' <- rnContext cls_doc context
638 ; fds' <- rnFds cls_doc fds
639 ; (ats', ats_fvs) <- rnATs ats
640 ; sigs' <- renameSigs okClsDclSig sigs
641 ; return (tyvars', context', fds', ats', ats_fvs, sigs') }
643 -- Check for duplicates among the associated types
644 ; let at_rdr_names_w_locs = [tcdLName ty | L _ ty <- ats]
645 ; checkDupNames at_doc at_rdr_names_w_locs
647 -- Check the signatures
648 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
649 ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
650 ; checkDupNames sig_doc sig_rdr_names_w_locs
651 -- Typechecker is responsible for checking that we only
652 -- give default-method bindings for things in this class.
653 -- The renamer *could* check this for class decls, but can't
654 -- for instance decls.
656 -- The newLocals call is tiresome: given a generic class decl
659 -- op {| x+y |} (Inl a) = ...
660 -- op {| x+y |} (Inr b) = ...
661 -- op {| a*b |} (a*b) = ...
662 -- we want to name both "x" tyvars with the same unique, so that they are
663 -- easy to group together in the typechecker.
664 ; (mbinds', meth_fvs)
665 <- extendTyVarEnvForMethodBinds tyvars' $ do
666 { name_env <- getLocalRdrEnv
667 ; let meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
668 gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
669 not (unLoc tv `elemLocalRdrEnv` name_env) ]
670 ; checkDupNames meth_doc meth_rdr_names_w_locs
671 ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
672 ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
675 ; docs' <- mapM (wrapLocM rnDocDecl) docs
677 ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
678 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
679 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
681 delFVs (map hsLTyVarName tyvars') $
682 extractHsCtxtTyNames context' `plusFV`
683 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
684 hsSigsFVs sigs' `plusFV`
688 meth_doc = text "In the default-methods for class" <+> ppr cname
689 cls_doc = text "In the declaration for class" <+> ppr cname
690 sig_doc = text "In the signatures for class" <+> ppr cname
691 at_doc = text "In the associated types for class" <+> ppr cname
693 badGadtStupidTheta tycon
694 = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
695 ptext SLIT("(You can put a context on each contructor, though.)")]
698 %*********************************************************
700 \subsection{Support code for type/data declarations}
702 %*********************************************************
705 -- Although, we are processing type patterns here, all type variables will
706 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
707 -- type declaration to which these patterns belong)
709 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
710 rnTyPats _ Nothing = return Nothing
711 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
713 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
714 rnConDecls tycon condecls
715 = mappM (wrapLocM rnConDecl) condecls
717 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
718 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
719 = do { addLocM checkConName name
721 ; new_name <- lookupLocatedTopBndrRn name
722 ; name_env <- getLocalRdrEnv
724 -- For H98 syntax, the tvs are the existential ones
725 -- For GADT syntax, the tvs are all the quantified tyvars
726 -- Hence the 'filter' in the ResTyH98 case only
727 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
728 arg_tys = hsConDeclArgTys details
729 implicit_tvs = case res_ty of
730 ResTyH98 -> filter not_in_scope $
732 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
735 Implicit -> userHsTyVarBndrs implicit_tvs
737 ; mb_doc' <- rnMbLHsDoc mb_doc
739 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
740 { new_context <- rnContext doc cxt
741 ; new_details <- rnConDeclDetails doc details
742 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
743 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
745 doc = text "In the definition of data constructor" <+> quotes (ppr name)
746 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
748 rnConResult _ details ResTyH98 = return (details, ResTyH98)
750 rnConResult doc details (ResTyGADT ty) = do
751 ty' <- rnHsSigType doc ty
752 let (arg_tys, res_ty) = splitHsFunType ty'
753 -- We can split it up, now the renamer has dealt with fixities
755 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
756 RecCon fields -> return (details, ResTyGADT ty')
757 InfixCon {} -> panic "rnConResult"
759 rnConDeclDetails doc (PrefixCon tys)
760 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
761 returnM (PrefixCon new_tys)
763 rnConDeclDetails doc (InfixCon ty1 ty2)
764 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
765 rnLHsType doc ty2 `thenM` \ new_ty2 ->
766 returnM (InfixCon new_ty1 new_ty2)
768 rnConDeclDetails doc (RecCon fields)
769 = do { checkDupNames doc (map cd_fld_name fields)
770 ; new_fields <- mappM (rnField doc) fields
771 ; return (RecCon new_fields) }
773 rnField doc (ConDeclField name ty haddock_doc)
774 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
775 rnLHsType doc ty `thenM` \ new_ty ->
776 rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
777 returnM (ConDeclField new_name new_ty new_haddock_doc)
779 -- Rename family declarations
781 -- * This function is parametrised by the routine handling the index
782 -- variables. On the toplevel, these are defining occurences, whereas they
783 -- are usage occurences for associated types.
785 rnFamily :: TyClDecl RdrName
786 -> (SDoc -> [LHsTyVarBndr RdrName] ->
787 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
788 RnM (TyClDecl Name, FreeVars))
789 -> RnM (TyClDecl Name, FreeVars)
791 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
792 tcdLName = tycon, tcdTyVars = tyvars})
794 do { checkM (isDataFlavour flavour -- for synonyms,
795 || not (null tyvars)) $ addErr needOneIdx -- #indexes >= 1
796 ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
797 ; tycon' <- lookupLocatedTopBndrRn tycon
798 ; returnM (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
799 tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
803 isDataFlavour DataFamily = True
804 isDataFlavour _ = False
806 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
807 needOneIdx = text "Type family declarations requires at least one type index"
809 -- Rename associated type declarations (in classes)
811 -- * This can be family declarations and (default) type instances
813 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
814 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
816 rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
817 rn_at (tydecl@TySynonym {}) =
819 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
821 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
823 lookupIdxVars _ tyvars cont =
824 do { checkForDups tyvars;
825 ; tyvars' <- mappM lookupIdxVar tyvars
828 -- Type index variables must be class parameters, which are the only
829 -- type variables in scope at this point.
830 lookupIdxVar (L l tyvar) =
832 name' <- lookupOccRn (hsTyVarName tyvar)
833 return $ L l (replaceTyVarName tyvar name')
835 -- Type variable may only occur once.
837 checkForDups [] = return ()
838 checkForDups (L loc tv:ltvs) =
839 do { setSrcSpan loc $
840 when (hsTyVarName tv `ltvElem` ltvs) $
841 addErr (repeatedTyVar tv)
845 rdrName `ltvElem` [] = False
846 rdrName `ltvElem` (L _ tv:ltvs)
847 | rdrName == hsTyVarName tv = True
848 | otherwise = rdrName `ltvElem` ltvs
850 noPatterns = text "Default definition for an associated synonym cannot have"
851 <+> text "type pattern"
853 repeatedTyVar tv = ptext SLIT("Illegal repeated type variable") <+>
856 -- This data decl will parse OK
858 -- treating "a" as the constructor.
859 -- It is really hard to make the parser spot this malformation.
860 -- So the renamer has to check that the constructor is legal
862 -- We can get an operator as the constructor, even in the prefix form:
863 -- data T = :% Int Int
864 -- from interface files, which always print in prefix form
866 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
869 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
873 %*********************************************************
875 \subsection{Support code for type/data declarations}
877 %*********************************************************
879 Get the mapping from constructors to fields for this module.
880 It's convenient to do this after the data type decls have been renamed
882 extendRecordFieldEnv :: [LTyClDecl Name] -> TcM TcGblEnv
883 extendRecordFieldEnv decls
884 = do { tcg_env <- getGblEnv
885 ; let field_env' = foldr get (tcg_field_env tcg_env) decls
886 ; return (tcg_env { tcg_field_env = field_env' }) }
888 get (L _ (TyData { tcdCons = cons })) env = foldr get_con env cons
891 get_con (L _ (ConDecl { con_name = con, con_details = RecCon flds })) env
892 = extendNameEnv env (unLoc con) (map (unLoc . cd_fld_name) flds)
897 %*********************************************************
899 \subsection{Support code to rename types}
901 %*********************************************************
904 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
907 = mappM (wrapLocM rn_fds) fds
910 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
911 rnHsTyVars doc tys2 `thenM` \ tys2' ->
912 returnM (tys1', tys2')
914 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
915 rnHsTyvar doc tyvar = lookupOccRn tyvar
919 %*********************************************************
923 %*********************************************************
929 h = ...$(thing "f")...
931 The splice can expand into literally anything, so when we do dependency
932 analysis we must assume that it might mention 'f'. So we simply treat
933 all locally-defined names as mentioned by any splice. This is terribly
934 brutal, but I don't see what else to do. For example, it'll mean
935 that every locally-defined thing will appear to be used, so no unused-binding
936 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
937 and that will crash the type checker because 'f' isn't in scope.
939 Currently, I'm not treating a splice as also mentioning every import,
940 which is a bit inconsistent -- but there are a lot of them. We might
941 thereby get some bogus unused-import warnings, but we won't crash the
942 type checker. Not very satisfactory really.
945 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
946 rnSplice (HsSplice n expr)
947 = do { checkTH expr "splice"
949 ; [n'] <- newLocalsRn [L loc n]
950 ; (expr', fvs) <- rnLExpr expr
952 -- Ugh! See Note [Splices] above
953 ; lcl_rdr <- getLocalRdrEnv
954 ; gbl_rdr <- getGlobalRdrEnv
955 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
957 lcl_names = mkNameSet (occEnvElts lcl_rdr)
959 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
962 checkTH e what = returnM () -- OK
964 checkTH e what -- Raise an error in a stage-1 compiler
965 = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
966 ptext SLIT("illegal in a stage-1 compiler"),