2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
9 rnTyClDecls, checkModDeprec,
13 #include "HsVersions.h"
15 import {-# SOURCE #-} RnExpr( rnLExpr )
18 import RdrName ( RdrName, isRdrDataCon, elemLocalRdrEnv,
19 globalRdrEnvElts, GlobalRdrElt(..), isLocalGRE )
20 import RdrHsSyn ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
22 import RnTypes ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
23 import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs, mkSigTvFn )
24 import RnEnv ( lookupLocalDataTcNames,
25 lookupLocatedTopBndrRn, lookupLocatedOccRn,
26 lookupOccRn, lookupTopBndrRn, newLocalsRn,
27 bindLocatedLocalsFV, bindPatSigTyVarsFV,
28 bindTyVarsRn, extendTyVarEnvFVRn,
29 bindLocalNames, checkDupNames, mapFvRn
31 import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
34 import HscTypes ( FixityEnv, FixItem(..),
35 Deprecations, Deprecs(..), DeprecTxt, plusDeprecs )
36 import Class ( FunDep )
37 import Name ( Name, nameOccName )
40 import OccName ( occEnvElts )
42 import SrcLoc ( Located(..), unLoc, noLoc )
43 import DynFlags ( DynFlag(..) )
44 import Maybes ( seqMaybe )
45 import Maybe ( isNothing, isJust )
46 import Monad ( liftM, when )
47 import BasicTypes ( Boxity(..) )
50 @rnSourceDecl@ `renames' declarations.
51 It simultaneously performs dependency analysis and precedence parsing.
52 It also does the following error checks:
55 Checks that tyvars are used properly. This includes checking
56 for undefined tyvars, and tyvars in contexts that are ambiguous.
57 (Some of this checking has now been moved to module @TcMonoType@,
58 since we don't have functional dependency information at this point.)
60 Checks that all variable occurences are defined.
62 Checks the @(..)@ etc constraints in the export list.
67 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
69 rnSrcDecls (HsGroup { hs_valds = val_decls,
70 hs_tyclds = tycl_decls,
71 hs_instds = inst_decls,
72 hs_derivds = deriv_decls,
74 hs_depds = deprec_decls,
75 hs_fords = foreign_decls,
76 hs_defds = default_decls,
77 hs_ruleds = rule_decls,
80 = do { -- Deal with deprecations (returns only the extra deprecations)
81 deprecs <- rnSrcDeprecDecls deprec_decls ;
82 updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
85 -- Deal with top-level fixity decls
86 -- (returns the total new fixity env)
87 rn_fix_decls <- rnSrcFixityDecls fix_decls ;
88 fix_env <- rnSrcFixityDeclsEnv rn_fix_decls ;
89 updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
92 -- Rename other declarations
93 traceRn (text "Start rnmono") ;
94 (rn_val_decls, bind_dus) <- rnTopBinds val_decls ;
95 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
97 -- You might think that we could build proper def/use information
98 -- for type and class declarations, but they can be involved
99 -- in mutual recursion across modules, and we only do the SCC
100 -- analysis for them in the type checker.
101 -- So we content ourselves with gathering uses only; that
102 -- means we'll only report a declaration as unused if it isn't
103 -- mentioned at all. Ah well.
104 traceRn (text "Start rnTyClDecls") ;
105 (rn_tycl_decls, src_fvs1)
106 <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls ;
107 traceRn (text "finish rnTyClDecls") ;
108 (rn_inst_decls, src_fvs2)
109 <- mapFvRn (wrapLocFstM rnSrcInstDecl) inst_decls ;
110 (rn_deriv_decls, src_fvs_deriv)
111 <- mapFvRn (wrapLocFstM rnSrcDerivDecl) deriv_decls ;
112 (rn_rule_decls, src_fvs3)
113 <- mapFvRn (wrapLocFstM rnHsRuleDecl) rule_decls ;
114 (rn_foreign_decls, src_fvs4)
115 <- mapFvRn (wrapLocFstM rnHsForeignDecl) foreign_decls ;
116 (rn_default_decls, src_fvs5)
117 <- mapFvRn (wrapLocFstM rnDefaultDecl) default_decls ;
120 rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
123 rn_group = HsGroup { hs_valds = rn_val_decls,
124 hs_tyclds = rn_tycl_decls,
125 hs_instds = rn_inst_decls,
126 hs_derivds = rn_deriv_decls,
127 hs_fixds = rn_fix_decls,
129 hs_fords = rn_foreign_decls,
130 hs_defds = rn_default_decls,
131 hs_ruleds = rn_rule_decls,
132 hs_docs = rn_docs } ;
134 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs_deriv, src_fvs3,
135 src_fvs4, src_fvs5] ;
136 src_dus = bind_dus `plusDU` usesOnly other_fvs
137 -- Note: src_dus will contain *uses* for locally-defined types
138 -- and classes, but no *defs* for them. (Because rnTyClDecl
139 -- returns only the uses.) This is a little
140 -- surprising but it doesn't actually matter at all.
143 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
144 traceRn (text "finish Dus" <+> ppr src_dus ) ;
145 tcg_env <- getGblEnv ;
146 return (tcg_env `addTcgDUs` src_dus, rn_group)
149 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
150 rnTyClDecls tycl_decls = do
151 (decls', fvs) <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls
154 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
155 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
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 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.
370 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
372 mapFvRn (wrapLocFstM rnATInst) atDecls
374 rnATInst tydecl@TyData {} = rnTyClDecl tydecl
375 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
377 pprPanic "RnSource.rnATInsts: invalid AT instance"
378 (ppr (tcdName tydecl))
381 For the method bindings in class and instance decls, we extend the
382 type variable environment iff -fglasgow-exts
385 extendTyVarEnvForMethodBinds tyvars thing_inside
386 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
387 if opt_GlasgowExts then
388 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
393 %*********************************************************
395 \subsection{Stand-alone deriving declarations}
397 %*********************************************************
400 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
401 rnSrcDerivDecl (DerivDecl ty)
402 = do ty' <- rnLHsType (text "a deriving decl") ty
403 let fvs = extractHsTyNames ty'
404 return (DerivDecl ty', fvs)
407 %*********************************************************
411 %*********************************************************
414 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
415 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
417 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
418 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
420 rnLExpr lhs `thenM` \ (lhs', fv_lhs') ->
421 rnLExpr rhs `thenM` \ (rhs', fv_rhs') ->
423 checkValidRule rule_name ids lhs' fv_lhs' `thenM_`
425 returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
426 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
428 doc = text "In the transformation rule" <+> ftext rule_name
430 get_var (RuleBndr v) = v
431 get_var (RuleBndrSig v _) = v
433 rn_var (RuleBndr (L loc v), id)
434 = returnM (RuleBndr (L loc id), emptyFVs)
435 rn_var (RuleBndrSig (L loc v) t, id)
436 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
437 returnM (RuleBndrSig (L loc id) t', fvs)
440 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
441 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
442 ptext SLIT("does not appear on left hand side")]
445 Note [Rule LHS validity checking]
446 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
447 Check the shape of a transformation rule LHS. Currently we only allow
448 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
449 @forall@'d variables.
451 We used restrict the form of the 'ei' to prevent you writing rules
452 with LHSs with a complicated desugaring (and hence unlikely to match);
453 (e.g. a case expression is not allowed: too elaborate.)
455 But there are legitimate non-trivial args ei, like sections and
456 lambdas. So it seems simmpler not to check at all, and that is why
457 check_e is commented out.
460 checkValidRule rule_name ids lhs' fv_lhs'
461 = do { -- Check for the form of the LHS
462 case (validRuleLhs ids lhs') of
464 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
466 -- Check that LHS vars are all bound
467 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
468 ; mappM (addErr . badRuleVar rule_name) bad_vars }
470 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
472 -- Just e => Not ok, and e is the offending expression
473 validRuleLhs foralls lhs
476 checkl (L loc e) = check e
478 check (OpApp e1 op _ e2) = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
479 check (HsApp e1 e2) = checkl e1 `seqMaybe` checkl_e e2
480 check (HsVar v) | v `notElem` foralls = Nothing
481 check other = Just other -- Failure
484 checkl_e (L loc e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
486 {- Commented out; see Note [Rule LHS validity checking] above
487 check_e (HsVar v) = Nothing
488 check_e (HsPar e) = checkl_e e
489 check_e (HsLit e) = Nothing
490 check_e (HsOverLit e) = Nothing
492 check_e (OpApp e1 op _ e2) = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
493 check_e (HsApp e1 e2) = checkl_e e1 `seqMaybe` checkl_e e2
494 check_e (NegApp e _) = checkl_e e
495 check_e (ExplicitList _ es) = checkl_es es
496 check_e (ExplicitTuple es _) = checkl_es es
497 check_e other = Just other -- Fails
499 checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
502 badRuleLhsErr name lhs bad_e
503 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
504 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
505 ptext SLIT("in left-hand side:") <+> ppr lhs])]
507 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
511 %*********************************************************
513 \subsection{Type, class and iface sig declarations}
515 %*********************************************************
517 @rnTyDecl@ uses the `global name function' to create a new type
518 declaration in which local names have been replaced by their original
519 names, reporting any unknown names.
521 Renaming type variables is a pain. Because they now contain uniques,
522 it is necessary to pass in an association list which maps a parsed
523 tyvar to its @Name@ representation.
524 In some cases (type signatures of values),
525 it is even necessary to go over the type first
526 in order to get the set of tyvars used by it, make an assoc list,
527 and then go over it again to rename the tyvars!
528 However, we can also do some scoping checks at the same time.
531 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
532 = lookupLocatedTopBndrRn name `thenM` \ name' ->
533 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
536 -- all flavours of type family declarations ("type family", "newtype fanily",
537 -- and "data family")
538 rnTyClDecl (tydecl@TyFamily {}) =
539 rnFamily tydecl bindTyVarsRn
541 -- "data", "newtype", "data instance, and "newtype instance" declarations
542 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
543 tcdLName = tycon, tcdTyVars = tyvars,
544 tcdTyPats = typatsMaybe, tcdCons = condecls,
545 tcdKindSig = sig, tcdDerivs = derivs})
546 | is_vanilla -- Normal Haskell data type decl
547 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
548 -- data type is syntactically illegal
549 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
550 do { tycon' <- if isFamInstDecl tydecl
551 then lookupLocatedOccRn tycon -- may be imported family
552 else lookupLocatedTopBndrRn tycon
553 ; context' <- rnContext data_doc context
554 ; typats' <- rnTyPats data_doc typatsMaybe
555 ; (derivs', deriv_fvs) <- rn_derivs derivs
556 ; checkDupNames data_doc con_names
557 ; condecls' <- rnConDecls (unLoc tycon') condecls
558 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
559 tcdLName = tycon', tcdTyVars = tyvars',
560 tcdTyPats = typats', tcdKindSig = Nothing,
561 tcdCons = condecls', tcdDerivs = derivs'},
562 delFVs (map hsLTyVarName tyvars') $
563 extractHsCtxtTyNames context' `plusFV`
564 plusFVs (map conDeclFVs condecls') `plusFV`
566 (if isFamInstDecl tydecl
567 then unitFV (unLoc tycon') -- type instance => use
572 = ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
573 do { tycon' <- if isFamInstDecl tydecl
574 then lookupLocatedOccRn tycon -- may be imported family
575 else lookupLocatedTopBndrRn tycon
576 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
577 ; tyvars' <- bindTyVarsRn data_doc tyvars
578 (\ tyvars' -> return tyvars')
579 -- For GADTs, the type variables in the declaration
580 -- do not scope over the constructor signatures
581 -- data T a where { T1 :: forall b. b-> b }
582 ; (derivs', deriv_fvs) <- rn_derivs derivs
583 ; checkDupNames data_doc con_names
584 ; condecls' <- rnConDecls (unLoc tycon') condecls
585 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
586 tcdLName = tycon', tcdTyVars = tyvars',
587 tcdTyPats = Nothing, tcdKindSig = sig,
588 tcdCons = condecls', tcdDerivs = derivs'},
589 plusFVs (map conDeclFVs condecls') `plusFV`
591 (if isFamInstDecl tydecl
592 then unitFV (unLoc tycon') -- type instance => use
596 is_vanilla = case condecls of -- Yuk
598 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
602 none (Just []) = True
605 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
606 con_names = map con_names_helper condecls
608 con_names_helper (L _ c) = con_name c
610 rn_derivs Nothing = returnM (Nothing, emptyFVs)
611 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
612 returnM (Just ds', extractHsTyNames_s ds')
614 -- "type" and "type instance" declarations
615 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
616 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
617 = bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
618 do { name' <- if isFamInstDecl tydecl
619 then lookupLocatedOccRn name -- may be imported family
620 else lookupLocatedTopBndrRn name
621 ; typats' <- rnTyPats syn_doc typatsMaybe
622 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
623 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
624 tcdTyPats = typats', tcdSynRhs = ty'},
625 delFVs (map hsLTyVarName tyvars') $
627 (if isFamInstDecl tydecl
628 then unitFV (unLoc name') -- type instance => use
632 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
634 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
635 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
636 tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
637 = do { cname' <- lookupLocatedTopBndrRn cname
639 -- Tyvars scope over superclass context and method signatures
640 ; (tyvars', context', fds', ats', ats_fvs, sigs')
641 <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
642 { context' <- rnContext cls_doc context
643 ; fds' <- rnFds cls_doc fds
644 ; (ats', ats_fvs) <- rnATs ats
645 ; sigs' <- renameSigs okClsDclSig sigs
646 ; return (tyvars', context', fds', ats', ats_fvs, sigs') }
648 -- Check for duplicates among the associated types
649 ; let at_rdr_names_w_locs = [tcdLName ty | L _ ty <- ats]
650 ; checkDupNames at_doc at_rdr_names_w_locs
652 -- Check the signatures
653 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
654 ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
655 ; checkDupNames sig_doc sig_rdr_names_w_locs
656 -- Typechecker is responsible for checking that we only
657 -- give default-method bindings for things in this class.
658 -- The renamer *could* check this for class decls, but can't
659 -- for instance decls.
661 -- The newLocals call is tiresome: given a generic class decl
664 -- op {| x+y |} (Inl a) = ...
665 -- op {| x+y |} (Inr b) = ...
666 -- op {| a*b |} (a*b) = ...
667 -- we want to name both "x" tyvars with the same unique, so that they are
668 -- easy to group together in the typechecker.
669 ; (mbinds', meth_fvs)
670 <- extendTyVarEnvForMethodBinds tyvars' $ do
671 { name_env <- getLocalRdrEnv
672 ; let meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
673 gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
674 not (unLoc tv `elemLocalRdrEnv` name_env) ]
675 ; checkDupNames meth_doc meth_rdr_names_w_locs
676 ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
677 ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
680 ; docs' <- mapM (wrapLocM rnDocDecl) docs
682 ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
683 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
684 tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
686 delFVs (map hsLTyVarName tyvars') $
687 extractHsCtxtTyNames context' `plusFV`
688 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
689 hsSigsFVs sigs' `plusFV`
693 meth_doc = text "In the default-methods for class" <+> ppr cname
694 cls_doc = text "In the declaration for class" <+> ppr cname
695 sig_doc = text "In the signatures for class" <+> ppr cname
696 at_doc = text "In the associated types for class" <+> ppr cname
698 badGadtStupidTheta tycon
699 = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
700 ptext SLIT("(You can put a context on each contructor, though.)")]
703 %*********************************************************
705 \subsection{Support code for type/data declarations}
707 %*********************************************************
710 -- Although, we are processing type patterns here, all type variables will
711 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
712 -- type declaration to which these patterns belong)
714 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
715 rnTyPats _ Nothing = return Nothing
716 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
718 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
719 rnConDecls tycon condecls
720 = mappM (wrapLocM rnConDecl) condecls
722 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
723 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
724 = do { addLocM checkConName name
726 ; new_name <- lookupLocatedTopBndrRn name
727 ; name_env <- getLocalRdrEnv
729 -- For H98 syntax, the tvs are the existential ones
730 -- For GADT syntax, the tvs are all the quantified tyvars
731 -- Hence the 'filter' in the ResTyH98 case only
732 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
733 arg_tys = hsConArgs details
734 implicit_tvs = case res_ty of
735 ResTyH98 -> filter not_in_scope $
737 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
740 Implicit -> userHsTyVarBndrs implicit_tvs
742 ; mb_doc' <- rnMbLHsDoc mb_doc
744 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
745 { new_context <- rnContext doc cxt
746 ; new_details <- rnConDetails doc details
747 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
748 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
750 doc = text "In the definition of data constructor" <+> quotes (ppr name)
751 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
753 rnConResult _ details ResTyH98 = return (details, ResTyH98)
755 rnConResult doc details (ResTyGADT ty) = do
756 ty' <- rnHsSigType doc ty
757 let (arg_tys, res_ty) = splitHsFunType ty'
758 -- We can split it up, now the renamer has dealt with fixities
760 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
761 RecCon fields -> return (details, ResTyGADT ty')
762 InfixCon {} -> panic "rnConResult"
764 rnConDetails doc (PrefixCon tys)
765 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
766 returnM (PrefixCon new_tys)
768 rnConDetails doc (InfixCon ty1 ty2)
769 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
770 rnLHsType doc ty2 `thenM` \ new_ty2 ->
771 returnM (InfixCon new_ty1 new_ty2)
773 rnConDetails doc (RecCon fields)
774 = checkDupNames doc field_names `thenM_`
775 mappM (rnField doc) fields `thenM` \ new_fields ->
776 returnM (RecCon new_fields)
778 field_names = [ name | HsRecField name _ _ <- fields ]
780 -- Document comments are renamed to Nothing here
781 rnField doc (HsRecField name ty haddock_doc)
782 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
783 rnLHsType doc ty `thenM` \ new_ty ->
784 rnMbLHsDoc haddock_doc `thenM` \ new_haddock_doc ->
785 returnM (HsRecField new_name new_ty new_haddock_doc)
787 -- Rename family declarations
789 -- * This function is parametrised by the routine handling the index
790 -- variables. On the toplevel, these are defining occurences, whereas they
791 -- are usage occurences for associated types.
793 rnFamily :: TyClDecl RdrName
794 -> (SDoc -> [LHsTyVarBndr RdrName] ->
795 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
796 RnM (TyClDecl Name, FreeVars))
797 -> RnM (TyClDecl Name, FreeVars)
799 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
800 tcdLName = tycon, tcdTyVars = tyvars})
802 do { checkM (isDataFlavour flavour -- for synonyms,
803 || not (null tyvars)) $ addErr needOneIdx -- #indexes >= 1
804 ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
805 ; tycon' <- lookupLocatedTopBndrRn tycon
806 ; returnM (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
807 tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
811 isDataFlavour (DataFamily _) = True
812 isDataFlavour _ = False
814 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
815 needOneIdx = text "Type family declarations requires at least one type index"
817 -- Rename associated type declarations (in classes)
819 -- * This can be family declarations and (default) type instances
821 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
822 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
824 rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
825 rn_at (tydecl@TySynonym {}) =
827 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
829 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
831 lookupIdxVars _ tyvars cont =
832 do { checkForDups tyvars;
833 ; tyvars' <- mappM lookupIdxVar tyvars
836 -- Type index variables must be class parameters, which are the only
837 -- type variables in scope at this point.
838 lookupIdxVar (L l tyvar) =
840 name' <- lookupOccRn (hsTyVarName tyvar)
841 return $ L l (replaceTyVarName tyvar name')
843 -- Type variable may only occur once.
845 checkForDups [] = return ()
846 checkForDups (L loc tv:ltvs) =
847 do { setSrcSpan loc $
848 when (hsTyVarName tv `ltvElem` ltvs) $
849 addErr (repeatedTyVar tv)
853 rdrName `ltvElem` [] = False
854 rdrName `ltvElem` (L _ tv:ltvs)
855 | rdrName == hsTyVarName tv = True
856 | otherwise = rdrName `ltvElem` ltvs
858 noPatterns = text "Default definition for an associated synonym cannot have"
859 <+> text "type pattern"
861 repeatedTyVar tv = ptext SLIT("Illegal repeated type variable") <+>
864 -- This data decl will parse OK
866 -- treating "a" as the constructor.
867 -- It is really hard to make the parser spot this malformation.
868 -- So the renamer has to check that the constructor is legal
870 -- We can get an operator as the constructor, even in the prefix form:
871 -- data T = :% Int Int
872 -- from interface files, which always print in prefix form
874 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
877 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
881 %*********************************************************
883 \subsection{Support code to rename types}
885 %*********************************************************
888 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
891 = mappM (wrapLocM rn_fds) fds
894 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
895 rnHsTyVars doc tys2 `thenM` \ tys2' ->
896 returnM (tys1', tys2')
898 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
899 rnHsTyvar doc tyvar = lookupOccRn tyvar
903 %*********************************************************
907 %*********************************************************
913 h = ...$(thing "f")...
915 The splice can expand into literally anything, so when we do dependency
916 analysis we must assume that it might mention 'f'. So we simply treat
917 all locally-defined names as mentioned by any splice. This is terribly
918 brutal, but I don't see what else to do. For example, it'll mean
919 that every locally-defined thing will appear to be used, so no unused-binding
920 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
921 and that will crash the type checker because 'f' isn't in scope.
923 Currently, I'm not treating a splice as also mentioning every import,
924 which is a bit inconsistent -- but there are a lot of them. We might
925 thereby get some bogus unused-import warnings, but we won't crash the
926 type checker. Not very satisfactory really.
929 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
930 rnSplice (HsSplice n expr)
931 = do { checkTH expr "splice"
933 ; [n'] <- newLocalsRn [L loc n]
934 ; (expr', fvs) <- rnLExpr expr
936 -- Ugh! See Note [Splices] above
937 ; lcl_rdr <- getLocalRdrEnv
938 ; gbl_rdr <- getGlobalRdrEnv
939 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
941 lcl_names = mkNameSet (occEnvElts lcl_rdr)
943 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
946 checkTH e what = returnM () -- OK
948 checkTH e what -- Raise an error in a stage-1 compiler
949 = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
950 ptext SLIT("illegal in a stage-1 compiler"),