2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
8 -- The above warning supression flag is a temporary kludge.
9 -- While working on this module you are encouraged to remove it and fix
10 -- any warnings in the module. See
11 -- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
15 rnSrcDecls, addTcgDUs,
20 #include "HsVersions.h"
22 import {-# SOURCE #-} RnExpr( rnLExpr )
25 import RdrName ( RdrName, isRdrDataCon, elemLocalRdrEnv,
26 globalRdrEnvElts, GlobalRdrElt(..), isLocalGRE )
27 import RdrHsSyn ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
29 import RnTypes ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
30 import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs, mkSigTvFn )
31 import RnEnv ( lookupLocalDataTcNames,
32 lookupLocatedTopBndrRn, lookupLocatedOccRn,
33 lookupOccRn, newLocalsRn,
34 bindLocatedLocalsFV, bindPatSigTyVarsFV,
35 bindTyVarsRn, extendTyVarEnvFVRn,
36 bindLocalNames, checkDupNames, mapFvRn
38 import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
41 import HscTypes ( FixityEnv, FixItem(..), Deprecations, Deprecs(..), plusDeprecs )
42 import Class ( FunDep )
43 import Name ( Name, nameOccName )
46 import OccName ( occEnvElts )
48 import SrcLoc ( Located(..), unLoc, noLoc )
49 import DynFlags ( DynFlag(..) )
50 import Maybes ( seqMaybe )
51 import Maybe ( isNothing )
52 import Monad ( liftM, when )
53 import BasicTypes ( Boxity(..) )
56 @rnSourceDecl@ `renames' declarations.
57 It simultaneously performs dependency analysis and precedence parsing.
58 It also does the following error checks:
61 Checks that tyvars are used properly. This includes checking
62 for undefined tyvars, and tyvars in contexts that are ambiguous.
63 (Some of this checking has now been moved to module @TcMonoType@,
64 since we don't have functional dependency information at this point.)
66 Checks that all variable occurences are defined.
68 Checks the @(..)@ etc constraints in the export list.
73 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
75 rnSrcDecls (HsGroup { hs_valds = val_decls,
76 hs_tyclds = tycl_decls,
77 hs_instds = inst_decls,
78 hs_derivds = deriv_decls,
80 hs_depds = deprec_decls,
81 hs_fords = foreign_decls,
82 hs_defds = default_decls,
83 hs_ruleds = rule_decls,
86 = do { -- Deal with deprecations (returns only the extra deprecations)
87 deprecs <- rnSrcDeprecDecls deprec_decls ;
88 updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
91 -- Deal with top-level fixity decls
92 -- (returns the total new fixity env)
93 rn_fix_decls <- rnSrcFixityDecls fix_decls ;
94 tcg_env <- extendGblFixityEnv rn_fix_decls ;
95 setGblEnv tcg_env $ do {
97 -- Rename type and class decls
98 -- You might think that we could build proper def/use information
99 -- for type and class declarations, but they can be involved
100 -- in mutual recursion across modules, and we only do the SCC
101 -- analysis for them in the type checker.
102 -- So we content ourselves with gathering uses only; that
103 -- means we'll only report a declaration as unused if it isn't
104 -- mentioned at all. Ah well.
105 traceRn (text "Start rnTyClDecls") ;
106 (rn_tycl_decls, src_fvs1) <- rnList rnTyClDecl tycl_decls ;
108 -- Extract the mapping from data constructors to field names
109 tcg_env <- extendRecordFieldEnv rn_tycl_decls ;
110 setGblEnv tcg_env $ do {
112 -- Value declarations
113 traceRn (text "Start rnmono") ;
114 (rn_val_decls, bind_dus) <- rnTopBinds val_decls ;
115 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
118 (rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ;
119 (rn_rule_decls, src_fvs3) <- rnList rnHsRuleDecl rule_decls ;
120 (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
121 (rn_default_decls, src_fvs5) <- rnList rnDefaultDecl default_decls ;
122 (rn_deriv_decls, src_fvs6) <- rnList rnSrcDerivDecl deriv_decls ;
124 -- Haddock docs; no free vars
125 rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
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_fvs6, 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 return (tcg_env `addTcgDUs` src_dus, rn_group)
153 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
154 -- Used for external core
155 rnTyClDecls tycl_decls = do (decls', fvs) <- rnList rnTyClDecl tycl_decls
158 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
159 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
161 rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
162 rnList f xs = mapFvRn (wrapLocFstM f) xs
166 %*********************************************************
170 %*********************************************************
173 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
174 rnDocDecl (DocCommentNext doc) = do
175 rn_doc <- rnHsDoc doc
176 return (DocCommentNext rn_doc)
177 rnDocDecl (DocCommentPrev doc) = do
178 rn_doc <- rnHsDoc doc
179 return (DocCommentPrev rn_doc)
180 rnDocDecl (DocCommentNamed str doc) = do
181 rn_doc <- rnHsDoc doc
182 return (DocCommentNamed str rn_doc)
183 rnDocDecl (DocGroup lev doc) = do
184 rn_doc <- rnHsDoc doc
185 return (DocGroup lev rn_doc)
189 %*********************************************************
191 Source-code fixity declarations
193 %*********************************************************
196 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
197 -- First rename the fixity decls, so we can put
198 -- the renamed decls in the renamed syntax tre
199 rnSrcFixityDecls fix_decls
200 = do fix_decls <- mapM rn_decl fix_decls
201 return (concat fix_decls)
203 rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
204 -- GHC extension: look up both the tycon and data con
205 -- for con-like things; hence returning a list
206 -- If neither are in scope, report an error; otherwise
207 -- add both to the fixity env
208 rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
209 = setSrcSpan name_loc $
210 do names <- lookupLocalDataTcNames rdr_name
211 return [ L loc (FixitySig (L name_loc name) fixity)
214 extendGblFixityEnv :: [LFixitySig Name] -> RnM TcGblEnv
215 -- Extend the global envt with fixity decls, checking for duplicate decls
216 extendGblFixityEnv decls
217 = do { env <- getGblEnv
218 ; fix_env' <- foldlM add_one (tcg_fix_env env) decls
219 ; return (env { tcg_fix_env = fix_env' }) }
221 add_one fix_env (L loc (FixitySig (L name_loc name) fixity))
222 | Just (FixItem _ _ loc') <- lookupNameEnv fix_env name
223 = do { setSrcSpan loc $
224 addLocErr (L name_loc name) (dupFixityDecl loc')
227 = return (extendNameEnv fix_env name fix_item)
229 fix_item = FixItem (nameOccName name) fixity loc
231 pprFixEnv :: FixityEnv -> SDoc
233 = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
236 dupFixityDecl loc rdr_name
237 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
238 ptext SLIT("also at ") <+> ppr loc
243 %*********************************************************
245 Source-code deprecations declarations
247 %*********************************************************
249 For deprecations, all we do is check that the names are in scope.
250 It's only imported deprecations, dealt with in RnIfaces, that we
251 gather them together.
254 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
258 rnSrcDeprecDecls decls
259 = mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
260 returnM (DeprecSome (mkNameEnv (concat pairs_s)))
262 rn_deprec (Deprecation rdr_name txt)
263 = lookupLocalDataTcNames rdr_name `thenM` \ names ->
264 returnM [(name, (nameOccName name, txt)) | name <- names]
267 %*********************************************************
269 \subsection{Source code declarations}
271 %*********************************************************
274 rnDefaultDecl (DefaultDecl tys)
275 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
276 returnM (DefaultDecl tys', fvs)
278 doc_str = text "In a `default' declaration"
281 %*********************************************************
283 \subsection{Foreign declarations}
285 %*********************************************************
288 rnHsForeignDecl (ForeignImport name ty spec)
289 = lookupLocatedTopBndrRn name `thenM` \ name' ->
290 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
291 returnM (ForeignImport name' ty' spec, fvs)
293 rnHsForeignDecl (ForeignExport name ty spec)
294 = lookupLocatedOccRn name `thenM` \ name' ->
295 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
296 returnM (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
297 -- NB: a foreign export is an *occurrence site* for name, so
298 -- we add it to the free-variable list. It might, for example,
299 -- be imported from another module
301 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
305 %*********************************************************
307 \subsection{Instance declarations}
309 %*********************************************************
312 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
313 -- Used for both source and interface file decls
314 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
316 -- Rename the associated types
317 -- The typechecker (not the renamer) checks that all
318 -- the declarations are for the right class
320 at_doc = text "In the associated types of an instance declaration"
321 at_names = map (head . tyClDeclNames . unLoc) ats
323 checkDupNames at_doc at_names `thenM_`
324 rnATInsts ats `thenM` \ (ats', at_fvs) ->
326 -- Rename the bindings
327 -- The typechecker (not the renamer) checks that all
328 -- the bindings are for the right class
330 meth_doc = text "In the bindings in an instance declaration"
331 meth_names = collectHsBindLocatedBinders mbinds
332 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
334 checkDupNames meth_doc meth_names `thenM_`
335 extendTyVarEnvForMethodBinds inst_tyvars (
336 -- (Slightly strangely) the forall-d tyvars scope over
337 -- the method bindings too
338 rnMethodBinds cls (\n->[]) -- No scoped tyvars
340 ) `thenM` \ (mbinds', meth_fvs) ->
341 -- Rename the prags and signatures.
342 -- Note that the type variables are not in scope here,
343 -- so that instance Eq a => Eq (T a) where
344 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
347 -- But the (unqualified) method names are in scope
349 binders = collectHsBindBinders mbinds'
350 ok_sig = okInstDclSig (mkNameSet binders)
352 bindLocalNames binders (renameSigs ok_sig uprags) `thenM` \ uprags' ->
354 returnM (InstDecl inst_ty' mbinds' uprags' ats',
355 meth_fvs `plusFV` at_fvs
356 `plusFV` hsSigsFVs uprags'
357 `plusFV` extractHsTyNames inst_ty')
358 -- We return the renamed associated data type declarations so
359 -- that they can be entered into the list of type declarations
360 -- for the binding group, but we also keep a copy in the instance.
361 -- The latter is needed for well-formedness checks in the type
362 -- checker (eg, to ensure that all ATs of the instance actually
363 -- receive a declaration).
364 -- NB: Even the copies in the instance declaration carry copies of
365 -- the instance context after renaming. This is a bit
366 -- strange, but should not matter (and it would be more work
367 -- to remove the context).
370 Renaming of the associated types in instances.
373 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
374 rnATInsts atDecls = rnList rnATInst atDecls
376 rnATInst tydecl@TyData {} = rnTyClDecl tydecl
377 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
379 pprPanic "RnSource.rnATInsts: invalid AT instance"
380 (ppr (tcdName tydecl))
383 For the method bindings in class and instance decls, we extend the
384 type variable environment iff -fglasgow-exts
387 extendTyVarEnvForMethodBinds tyvars thing_inside
388 = do { scoped_tvs <- doptM Opt_ScopedTypeVariables
390 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
395 %*********************************************************
397 \subsection{Stand-alone deriving declarations}
399 %*********************************************************
402 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
403 rnSrcDerivDecl (DerivDecl ty)
404 = do ty' <- rnLHsType (text "a deriving decl") ty
405 let fvs = extractHsTyNames ty'
406 return (DerivDecl ty', fvs)
409 %*********************************************************
413 %*********************************************************
416 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
417 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
419 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
420 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
422 rnLExpr lhs `thenM` \ (lhs', fv_lhs') ->
423 rnLExpr rhs `thenM` \ (rhs', fv_rhs') ->
425 checkValidRule rule_name ids lhs' fv_lhs' `thenM_`
427 returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
428 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
430 doc = text "In the transformation rule" <+> ftext rule_name
432 get_var (RuleBndr v) = v
433 get_var (RuleBndrSig v _) = v
435 rn_var (RuleBndr (L loc v), id)
436 = returnM (RuleBndr (L loc id), emptyFVs)
437 rn_var (RuleBndrSig (L loc v) t, id)
438 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
439 returnM (RuleBndrSig (L loc id) t', fvs)
442 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
443 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
444 ptext SLIT("does not appear on left hand side")]
447 Note [Rule LHS validity checking]
448 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
449 Check the shape of a transformation rule LHS. Currently we only allow
450 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
451 @forall@'d variables.
453 We used restrict the form of the 'ei' to prevent you writing rules
454 with LHSs with a complicated desugaring (and hence unlikely to match);
455 (e.g. a case expression is not allowed: too elaborate.)
457 But there are legitimate non-trivial args ei, like sections and
458 lambdas. So it seems simmpler not to check at all, and that is why
459 check_e is commented out.
462 checkValidRule rule_name ids lhs' fv_lhs'
463 = do { -- Check for the form of the LHS
464 case (validRuleLhs ids lhs') of
466 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
468 -- Check that LHS vars are all bound
469 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
470 ; mappM (addErr . badRuleVar rule_name) bad_vars }
472 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
474 -- Just e => Not ok, and e is the offending expression
475 validRuleLhs foralls lhs
478 checkl (L loc e) = check e
480 check (OpApp e1 op _ e2) = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
481 check (HsApp e1 e2) = checkl e1 `seqMaybe` checkl_e e2
482 check (HsVar v) | v `notElem` foralls = Nothing
483 check other = Just other -- Failure
486 checkl_e (L loc e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
488 {- Commented out; see Note [Rule LHS validity checking] above
489 check_e (HsVar v) = Nothing
490 check_e (HsPar e) = checkl_e e
491 check_e (HsLit e) = Nothing
492 check_e (HsOverLit e) = Nothing
494 check_e (OpApp e1 op _ e2) = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
495 check_e (HsApp e1 e2) = checkl_e e1 `seqMaybe` checkl_e e2
496 check_e (NegApp e _) = checkl_e e
497 check_e (ExplicitList _ es) = checkl_es es
498 check_e (ExplicitTuple es _) = checkl_es es
499 check_e other = Just other -- Fails
501 checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
504 badRuleLhsErr name lhs bad_e
505 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
506 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
507 ptext SLIT("in left-hand side:") <+> ppr lhs])]
509 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
513 %*********************************************************
515 \subsection{Type, class and iface sig declarations}
517 %*********************************************************
519 @rnTyDecl@ uses the `global name function' to create a new type
520 declaration in which local names have been replaced by their original
521 names, reporting any unknown names.
523 Renaming type variables is a pain. Because they now contain uniques,
524 it is necessary to pass in an association list which maps a parsed
525 tyvar to its @Name@ representation.
526 In some cases (type signatures of values),
527 it is even necessary to go over the type first
528 in order to get the set of tyvars used by it, make an assoc list,
529 and then go over it again to rename the tyvars!
530 However, we can also do some scoping checks at the same time.
533 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
534 = lookupLocatedTopBndrRn name `thenM` \ name' ->
535 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
538 -- all flavours of type family declarations ("type family", "newtype fanily",
539 -- and "data family")
540 rnTyClDecl (tydecl@TyFamily {}) =
541 rnFamily tydecl bindTyVarsRn
543 -- "data", "newtype", "data instance, and "newtype instance" declarations
544 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
545 tcdLName = tycon, tcdTyVars = tyvars,
546 tcdTyPats = typatsMaybe, tcdCons = condecls,
547 tcdKindSig = sig, tcdDerivs = derivs})
548 | is_vanilla -- Normal Haskell data type decl
549 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
550 -- data type is syntactically illegal
551 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
552 do { tycon' <- if isFamInstDecl tydecl
553 then lookupLocatedOccRn tycon -- may be imported family
554 else lookupLocatedTopBndrRn tycon
555 ; context' <- rnContext data_doc context
556 ; typats' <- rnTyPats data_doc typatsMaybe
557 ; (derivs', deriv_fvs) <- rn_derivs derivs
558 ; checkDupNames data_doc con_names
559 ; condecls' <- rnConDecls (unLoc tycon') condecls
560 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
561 tcdLName = tycon', tcdTyVars = tyvars',
562 tcdTyPats = typats', tcdKindSig = Nothing,
563 tcdCons = condecls', tcdDerivs = derivs'},
564 delFVs (map hsLTyVarName tyvars') $
565 extractHsCtxtTyNames context' `plusFV`
566 plusFVs (map conDeclFVs condecls') `plusFV`
568 (if isFamInstDecl tydecl
569 then unitFV (unLoc tycon') -- type instance => use
574 = ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
575 do { tycon' <- if isFamInstDecl tydecl
576 then lookupLocatedOccRn tycon -- may be imported family
577 else lookupLocatedTopBndrRn tycon
578 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
579 ; tyvars' <- bindTyVarsRn data_doc tyvars
580 (\ tyvars' -> return tyvars')
581 -- For GADTs, the type variables in the declaration
582 -- do not scope over the constructor signatures
583 -- data T a where { T1 :: forall b. b-> b }
584 ; (derivs', deriv_fvs) <- rn_derivs derivs
585 ; checkDupNames data_doc con_names
586 ; condecls' <- rnConDecls (unLoc tycon') condecls
587 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
588 tcdLName = tycon', tcdTyVars = tyvars',
589 tcdTyPats = Nothing, tcdKindSig = sig,
590 tcdCons = condecls', tcdDerivs = derivs'},
591 plusFVs (map conDeclFVs condecls') `plusFV`
593 (if isFamInstDecl tydecl
594 then unitFV (unLoc tycon') -- type instance => use
598 is_vanilla = case condecls of -- Yuk
600 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
604 none (Just []) = True
607 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
608 con_names = map con_names_helper condecls
610 con_names_helper (L _ c) = con_name c
612 rn_derivs Nothing = returnM (Nothing, emptyFVs)
613 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
614 returnM (Just ds', extractHsTyNames_s ds')
616 -- "type" and "type instance" declarations
617 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
618 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
619 = bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
620 do { name' <- if isFamInstDecl tydecl
621 then lookupLocatedOccRn name -- may be imported family
622 else lookupLocatedTopBndrRn name
623 ; typats' <- rnTyPats syn_doc typatsMaybe
624 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
625 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
626 tcdTyPats = typats', tcdSynRhs = ty'},
627 delFVs (map hsLTyVarName tyvars') $
629 (if isFamInstDecl tydecl
630 then unitFV (unLoc name') -- type instance => use
634 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
636 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
637 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
638 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
639 = do { cname' <- lookupLocatedTopBndrRn cname
641 -- Tyvars scope over superclass context and method signatures
642 ; (tyvars', context', fds', ats', ats_fvs, sigs')
643 <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
644 { context' <- rnContext cls_doc context
645 ; fds' <- rnFds cls_doc fds
646 ; (ats', ats_fvs) <- rnATs ats
647 ; sigs' <- renameSigs okClsDclSig sigs
648 ; return (tyvars', context', fds', ats', ats_fvs, sigs') }
650 -- Check for duplicates among the associated types
651 ; let at_rdr_names_w_locs = [tcdLName ty | L _ ty <- ats]
652 ; checkDupNames at_doc at_rdr_names_w_locs
654 -- Check the signatures
655 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
656 ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
657 ; checkDupNames sig_doc sig_rdr_names_w_locs
658 -- Typechecker is responsible for checking that we only
659 -- give default-method bindings for things in this class.
660 -- The renamer *could* check this for class decls, but can't
661 -- for instance decls.
663 -- The newLocals call is tiresome: given a generic class decl
666 -- op {| x+y |} (Inl a) = ...
667 -- op {| x+y |} (Inr b) = ...
668 -- op {| a*b |} (a*b) = ...
669 -- we want to name both "x" tyvars with the same unique, so that they are
670 -- easy to group together in the typechecker.
671 ; (mbinds', meth_fvs)
672 <- extendTyVarEnvForMethodBinds tyvars' $ do
673 { name_env <- getLocalRdrEnv
674 ; let meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
675 gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
676 not (unLoc tv `elemLocalRdrEnv` name_env) ]
677 ; checkDupNames meth_doc meth_rdr_names_w_locs
678 ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
679 ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
682 ; docs' <- mapM (wrapLocM rnDocDecl) docs
684 ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
685 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
686 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
688 delFVs (map hsLTyVarName tyvars') $
689 extractHsCtxtTyNames context' `plusFV`
690 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
691 hsSigsFVs sigs' `plusFV`
695 meth_doc = text "In the default-methods for class" <+> ppr cname
696 cls_doc = text "In the declaration for class" <+> ppr cname
697 sig_doc = text "In the signatures for class" <+> ppr cname
698 at_doc = text "In the associated types for class" <+> ppr cname
700 badGadtStupidTheta tycon
701 = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
702 ptext SLIT("(You can put a context on each contructor, though.)")]
705 %*********************************************************
707 \subsection{Support code for type/data declarations}
709 %*********************************************************
712 -- Although, we are processing type patterns here, all type variables will
713 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
714 -- type declaration to which these patterns belong)
716 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
717 rnTyPats _ Nothing = return Nothing
718 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
720 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
721 rnConDecls tycon condecls
722 = mappM (wrapLocM rnConDecl) condecls
724 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
725 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
726 = do { addLocM checkConName name
728 ; new_name <- lookupLocatedTopBndrRn name
729 ; name_env <- getLocalRdrEnv
731 -- For H98 syntax, the tvs are the existential ones
732 -- For GADT syntax, the tvs are all the quantified tyvars
733 -- Hence the 'filter' in the ResTyH98 case only
734 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
735 arg_tys = hsConDeclArgTys details
736 implicit_tvs = case res_ty of
737 ResTyH98 -> filter not_in_scope $
739 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
742 Implicit -> userHsTyVarBndrs implicit_tvs
744 ; mb_doc' <- rnMbLHsDoc mb_doc
746 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
747 { new_context <- rnContext doc cxt
748 ; new_details <- rnConDeclDetails doc details
749 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
750 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
752 doc = text "In the definition of data constructor" <+> quotes (ppr name)
753 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
755 rnConResult _ details ResTyH98 = return (details, ResTyH98)
757 rnConResult doc details (ResTyGADT ty) = do
758 ty' <- rnHsSigType doc ty
759 let (arg_tys, res_ty) = splitHsFunType ty'
760 -- We can split it up, now the renamer has dealt with fixities
762 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
763 RecCon fields -> return (details, ResTyGADT ty')
764 InfixCon {} -> panic "rnConResult"
766 rnConDeclDetails doc (PrefixCon tys)
767 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
768 returnM (PrefixCon new_tys)
770 rnConDeclDetails doc (InfixCon ty1 ty2)
771 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
772 rnLHsType doc ty2 `thenM` \ new_ty2 ->
773 returnM (InfixCon new_ty1 new_ty2)
775 rnConDeclDetails doc (RecCon fields)
776 = do { checkDupNames doc (map cd_fld_name fields)
777 ; new_fields <- mappM (rnField doc) fields
778 ; return (RecCon new_fields) }
780 rnField doc (ConDeclField name ty haddock_doc)
781 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
782 rnLHsType doc ty `thenM` \ new_ty ->
783 rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
784 returnM (ConDeclField new_name new_ty new_haddock_doc)
786 -- Rename family declarations
788 -- * This function is parametrised by the routine handling the index
789 -- variables. On the toplevel, these are defining occurences, whereas they
790 -- are usage occurences for associated types.
792 rnFamily :: TyClDecl RdrName
793 -> (SDoc -> [LHsTyVarBndr RdrName] ->
794 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
795 RnM (TyClDecl Name, FreeVars))
796 -> RnM (TyClDecl Name, FreeVars)
798 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
799 tcdLName = tycon, tcdTyVars = tyvars})
801 do { checkM (isDataFlavour flavour -- for synonyms,
802 || not (null tyvars)) $ addErr needOneIdx -- #indexes >= 1
803 ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
804 ; tycon' <- lookupLocatedTopBndrRn tycon
805 ; returnM (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
806 tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
810 isDataFlavour DataFamily = True
811 isDataFlavour _ = False
813 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
814 needOneIdx = text "Type family declarations requires at least one type index"
816 -- Rename associated type declarations (in classes)
818 -- * This can be family declarations and (default) type instances
820 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
821 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
823 rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
824 rn_at (tydecl@TySynonym {}) =
826 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
828 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
830 lookupIdxVars _ tyvars cont =
831 do { checkForDups tyvars;
832 ; tyvars' <- mappM lookupIdxVar tyvars
835 -- Type index variables must be class parameters, which are the only
836 -- type variables in scope at this point.
837 lookupIdxVar (L l tyvar) =
839 name' <- lookupOccRn (hsTyVarName tyvar)
840 return $ L l (replaceTyVarName tyvar name')
842 -- Type variable may only occur once.
844 checkForDups [] = return ()
845 checkForDups (L loc tv:ltvs) =
846 do { setSrcSpan loc $
847 when (hsTyVarName tv `ltvElem` ltvs) $
848 addErr (repeatedTyVar tv)
852 rdrName `ltvElem` [] = False
853 rdrName `ltvElem` (L _ tv:ltvs)
854 | rdrName == hsTyVarName tv = True
855 | otherwise = rdrName `ltvElem` ltvs
857 noPatterns = text "Default definition for an associated synonym cannot have"
858 <+> text "type pattern"
860 repeatedTyVar tv = ptext SLIT("Illegal repeated type variable") <+>
863 -- This data decl will parse OK
865 -- treating "a" as the constructor.
866 -- It is really hard to make the parser spot this malformation.
867 -- So the renamer has to check that the constructor is legal
869 -- We can get an operator as the constructor, even in the prefix form:
870 -- data T = :% Int Int
871 -- from interface files, which always print in prefix form
873 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
876 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
880 %*********************************************************
882 \subsection{Support code for type/data declarations}
884 %*********************************************************
886 Get the mapping from constructors to fields for this module.
887 It's convenient to do this after the data type decls have been renamed
889 extendRecordFieldEnv :: [LTyClDecl Name] -> TcM TcGblEnv
890 extendRecordFieldEnv decls
891 = do { tcg_env <- getGblEnv
892 ; let field_env' = foldr get (tcg_field_env tcg_env) decls
893 ; return (tcg_env { tcg_field_env = field_env' }) }
895 get (L _ (TyData { tcdCons = cons })) env = foldr get_con env cons
898 get_con (L _ (ConDecl { con_name = con, con_details = RecCon flds })) env
899 = extendNameEnv env (unLoc con) (map (unLoc . cd_fld_name) flds)
904 %*********************************************************
906 \subsection{Support code to rename types}
908 %*********************************************************
911 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
914 = mappM (wrapLocM rn_fds) fds
917 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
918 rnHsTyVars doc tys2 `thenM` \ tys2' ->
919 returnM (tys1', tys2')
921 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
922 rnHsTyvar doc tyvar = lookupOccRn tyvar
926 %*********************************************************
930 %*********************************************************
936 h = ...$(thing "f")...
938 The splice can expand into literally anything, so when we do dependency
939 analysis we must assume that it might mention 'f'. So we simply treat
940 all locally-defined names as mentioned by any splice. This is terribly
941 brutal, but I don't see what else to do. For example, it'll mean
942 that every locally-defined thing will appear to be used, so no unused-binding
943 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
944 and that will crash the type checker because 'f' isn't in scope.
946 Currently, I'm not treating a splice as also mentioning every import,
947 which is a bit inconsistent -- but there are a lot of them. We might
948 thereby get some bogus unused-import warnings, but we won't crash the
949 type checker. Not very satisfactory really.
952 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
953 rnSplice (HsSplice n expr)
954 = do { checkTH expr "splice"
956 ; [n'] <- newLocalsRn [L loc n]
957 ; (expr', fvs) <- rnLExpr expr
959 -- Ugh! See Note [Splices] above
960 ; lcl_rdr <- getLocalRdrEnv
961 ; gbl_rdr <- getGlobalRdrEnv
962 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
964 lcl_names = mkNameSet (occEnvElts lcl_rdr)
966 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
969 checkTH e what = returnM () -- OK
971 checkTH e what -- Raise an error in a stage-1 compiler
972 = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
973 ptext SLIT("illegal in a stage-1 compiler"),