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, isRdrTyVar, rdrNameOcc,
19 elemLocalRdrEnv, globalRdrEnvElts, GlobalRdrElt(..),
21 import RdrHsSyn ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
23 import RnTypes ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
24 import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs, mkSigTvFn )
25 import RnEnv ( lookupLocalDataTcNames,
26 lookupLocatedTopBndrRn, lookupLocatedOccRn,
27 lookupOccRn, newLocalsRn,
28 bindLocatedLocalsFV, bindPatSigTyVarsFV,
29 bindTyVarsRn, extendTyVarEnvFVRn,
30 bindLocalNames, checkDupNames, mapFvRn
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,
73 hs_depds = deprec_decls,
74 hs_fords = foreign_decls,
75 hs_defds = default_decls,
76 hs_ruleds = rule_decls })
78 = do { -- Deal with deprecations (returns only the extra deprecations)
79 deprecs <- rnSrcDeprecDecls deprec_decls ;
80 updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
83 -- Deal with top-level fixity decls
84 -- (returns the total new fixity env)
85 rn_fix_decls <- rnSrcFixityDecls fix_decls ;
86 fix_env <- rnSrcFixityDeclsEnv rn_fix_decls ;
87 updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
90 -- Rename other declarations
91 traceRn (text "Start rnmono") ;
92 (rn_val_decls, bind_dus) <- rnTopBinds val_decls ;
93 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
95 -- You might think that we could build proper def/use information
96 -- for type and class declarations, but they can be involved
97 -- in mutual recursion across modules, and we only do the SCC
98 -- analysis for them in the type checker.
99 -- So we content ourselves with gathering uses only; that
100 -- means we'll only report a declaration as unused if it isn't
101 -- mentioned at all. Ah well.
102 (rn_tycl_decls, src_fvs1)
103 <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls ;
104 (rn_inst_decls, src_fvs2)
105 <- mapFvRn (wrapLocFstM rnSrcInstDecl) inst_decls ;
106 (rn_rule_decls, src_fvs3)
107 <- mapFvRn (wrapLocFstM rnHsRuleDecl) rule_decls ;
108 (rn_foreign_decls, src_fvs4)
109 <- mapFvRn (wrapLocFstM rnHsForeignDecl) foreign_decls ;
110 (rn_default_decls, src_fvs5)
111 <- mapFvRn (wrapLocFstM rnDefaultDecl) default_decls ;
114 rn_group = HsGroup { hs_valds = rn_val_decls,
115 hs_tyclds = rn_tycl_decls,
116 hs_instds = rn_inst_decls,
117 hs_fixds = rn_fix_decls,
119 hs_fords = rn_foreign_decls,
120 hs_defds = rn_default_decls,
121 hs_ruleds = rn_rule_decls } ;
123 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3,
124 src_fvs4, src_fvs5] ;
125 src_dus = bind_dus `plusDU` usesOnly other_fvs
126 -- Note: src_dus will contain *uses* for locally-defined types
127 -- and classes, but no *defs* for them. (Because rnTyClDecl
128 -- returns only the uses.) This is a little
129 -- surprising but it doesn't actually matter at all.
132 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
133 traceRn (text "finish Dus" <+> ppr src_dus ) ;
134 tcg_env <- getGblEnv ;
135 return (tcg_env `addTcgDUs` src_dus, rn_group)
138 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
139 rnTyClDecls tycl_decls = do
140 (decls', fvs) <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls
143 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
144 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
148 %*********************************************************
150 Source-code fixity declarations
152 %*********************************************************
155 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
156 rnSrcFixityDecls fix_decls
157 = do fix_decls <- mapM rnFixityDecl fix_decls
158 return (concat fix_decls)
160 rnFixityDecl :: LFixitySig RdrName -> RnM [LFixitySig Name]
161 rnFixityDecl (L loc (FixitySig (L nameLoc rdr_name) fixity))
162 = setSrcSpan nameLoc $
163 -- GHC extension: look up both the tycon and data con
164 -- for con-like things
165 -- If neither are in scope, report an error; otherwise
166 -- add both to the fixity env
167 do names <- lookupLocalDataTcNames rdr_name
168 return [ L loc (FixitySig (L nameLoc name) fixity)
171 rnSrcFixityDeclsEnv :: [LFixitySig Name] -> RnM FixityEnv
172 rnSrcFixityDeclsEnv fix_decls
173 = getGblEnv `thenM` \ gbl_env ->
174 foldlM rnFixityDeclEnv (tcg_fix_env gbl_env)
175 fix_decls `thenM` \ fix_env ->
176 traceRn (text "fixity env" <+> pprFixEnv fix_env) `thenM_`
179 rnFixityDeclEnv :: FixityEnv -> LFixitySig Name -> RnM FixityEnv
180 rnFixityDeclEnv fix_env (L loc (FixitySig (L nameLoc name) fixity))
181 = case lookupNameEnv fix_env name of
182 Just (FixItem _ _ loc')
183 -> do addLocErr (L nameLoc name) (dupFixityDecl loc')
186 -> return (extendNameEnv fix_env name fix_item)
187 where fix_item = FixItem (nameOccName name) fixity nameLoc
189 pprFixEnv :: FixityEnv -> SDoc
191 = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
194 dupFixityDecl loc rdr_name
195 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
196 ptext SLIT("also at ") <+> ppr loc
201 %*********************************************************
203 Source-code deprecations declarations
205 %*********************************************************
207 For deprecations, all we do is check that the names are in scope.
208 It's only imported deprecations, dealt with in RnIfaces, that we
209 gather them together.
212 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
216 rnSrcDeprecDecls decls
217 = mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
218 returnM (DeprecSome (mkNameEnv (concat pairs_s)))
220 rn_deprec (Deprecation rdr_name txt)
221 = lookupLocalDataTcNames rdr_name `thenM` \ names ->
222 returnM [(name, (nameOccName name, txt)) | name <- names]
224 checkModDeprec :: Maybe DeprecTxt -> Deprecations
225 -- Check for a module deprecation; done once at top level
226 checkModDeprec Nothing = NoDeprecs
227 checkModDeprec (Just txt) = DeprecAll txt
230 %*********************************************************
232 \subsection{Source code declarations}
234 %*********************************************************
237 rnDefaultDecl (DefaultDecl tys)
238 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
239 returnM (DefaultDecl tys', fvs)
241 doc_str = text "In a `default' declaration"
244 %*********************************************************
246 \subsection{Foreign declarations}
248 %*********************************************************
251 rnHsForeignDecl (ForeignImport name ty spec)
252 = lookupLocatedTopBndrRn name `thenM` \ name' ->
253 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
254 returnM (ForeignImport name' ty' spec, fvs)
256 rnHsForeignDecl (ForeignExport name ty spec)
257 = lookupLocatedOccRn name `thenM` \ name' ->
258 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
259 returnM (ForeignExport name' ty' spec, fvs )
260 -- NB: a foreign export is an *occurrence site* for name, so
261 -- we add it to the free-variable list. It might, for example,
262 -- be imported from another module
264 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
268 %*********************************************************
270 \subsection{Instance declarations}
272 %*********************************************************
275 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
276 -- Used for both source and interface file decls
277 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
279 -- Rename the associated types
280 -- The typechecker (not the renamer) checks that all
281 -- the declarations are for the right class
283 at_doc = text "In the associated types of an instance declaration"
284 at_names = map (head . tyClDeclNames . unLoc) ats
286 checkDupNames at_doc at_names `thenM_`
287 rnATInsts ats `thenM` \ (ats', at_fvs) ->
289 -- Rename the bindings
290 -- The typechecker (not the renamer) checks that all
291 -- the bindings are for the right class
293 meth_doc = text "In the bindings in an instance declaration"
294 meth_names = collectHsBindLocatedBinders mbinds
295 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
297 checkDupNames meth_doc meth_names `thenM_`
298 extendTyVarEnvForMethodBinds inst_tyvars (
299 -- (Slightly strangely) the forall-d tyvars scope over
300 -- the method bindings too
301 rnMethodBinds cls (\n->[]) -- No scoped tyvars
303 ) `thenM` \ (mbinds', meth_fvs) ->
304 -- Rename the prags and signatures.
305 -- Note that the type variables are not in scope here,
306 -- so that instance Eq a => Eq (T a) where
307 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
310 -- But the (unqualified) method names are in scope
312 binders = collectHsBindBinders mbinds'
313 ok_sig = okInstDclSig (mkNameSet binders)
315 bindLocalNames binders (renameSigs ok_sig uprags) `thenM` \ uprags' ->
317 returnM (InstDecl inst_ty' mbinds' uprags' ats',
318 meth_fvs `plusFV` at_fvs
319 `plusFV` hsSigsFVs uprags'
320 `plusFV` extractHsTyNames inst_ty')
321 -- We return the renamed associated data type declarations so
322 -- that they can be entered into the list of type declarations
323 -- for the binding group, but we also keep a copy in the instance.
324 -- The latter is needed for well-formedness checks in the type
325 -- checker (eg, to ensure that all ATs of the instance actually
326 -- receive a declaration).
327 -- NB: Even the copies in the instance declaration carry copies of
328 -- the instance context after renaming. This is a bit
329 -- strange, but should not matter (and it would be more work
330 -- to remove the context).
333 Renaming of the associated types in instances.
335 * We raise an error if we encounter a kind signature in an instance.
338 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
340 mapFvRn (wrapLocFstM rnATInst) atDecls
342 rnATInst tydecl@TyFunction {} =
346 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
347 rnATInst tydecl@TyData {} =
349 checkM (not . isKindSigDecl $ tydecl) $ addErr noKindSig
352 panic "RnSource.rnATInsts: not a type declaration"
354 noKindSig = text "Instances cannot have kind signatures"
357 For the method bindings in class and instance decls, we extend the
358 type variable environment iff -fglasgow-exts
361 extendTyVarEnvForMethodBinds tyvars thing_inside
362 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
363 if opt_GlasgowExts then
364 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
370 %*********************************************************
374 %*********************************************************
377 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
378 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
380 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
381 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
383 rnLExpr lhs `thenM` \ (lhs', fv_lhs') ->
384 rnLExpr rhs `thenM` \ (rhs', fv_rhs') ->
386 checkValidRule rule_name ids lhs' fv_lhs' `thenM_`
388 returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
389 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
391 doc = text "In the transformation rule" <+> ftext rule_name
393 get_var (RuleBndr v) = v
394 get_var (RuleBndrSig v _) = v
396 rn_var (RuleBndr (L loc v), id)
397 = returnM (RuleBndr (L loc id), emptyFVs)
398 rn_var (RuleBndrSig (L loc v) t, id)
399 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
400 returnM (RuleBndrSig (L loc id) t', fvs)
403 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
404 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
405 ptext SLIT("does not appear on left hand side")]
408 Note [Rule LHS validity checking]
409 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
410 Check the shape of a transformation rule LHS. Currently we only allow
411 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
412 @forall@'d variables.
414 We used restrict the form of the 'ei' to prevent you writing rules
415 with LHSs with a complicated desugaring (and hence unlikely to match);
416 (e.g. a case expression is not allowed: too elaborate.)
418 But there are legitimate non-trivial args ei, like sections and
419 lambdas. So it seems simmpler not to check at all, and that is why
420 check_e is commented out.
423 checkValidRule rule_name ids lhs' fv_lhs'
424 = do { -- Check for the form of the LHS
425 case (validRuleLhs ids lhs') of
427 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
429 -- Check that LHS vars are all bound
430 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
431 ; mappM (addErr . badRuleVar rule_name) bad_vars }
433 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
435 -- Just e => Not ok, and e is the offending expression
436 validRuleLhs foralls lhs
439 checkl (L loc e) = check e
441 check (OpApp e1 op _ e2) = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
442 check (HsApp e1 e2) = checkl e1 `seqMaybe` checkl_e e2
443 check (HsVar v) | v `notElem` foralls = Nothing
444 check other = Just other -- Failure
447 checkl_e (L loc e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
449 {- Commented out; see Note [Rule LHS validity checking] above
450 check_e (HsVar v) = Nothing
451 check_e (HsPar e) = checkl_e e
452 check_e (HsLit e) = Nothing
453 check_e (HsOverLit e) = Nothing
455 check_e (OpApp e1 op _ e2) = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
456 check_e (HsApp e1 e2) = checkl_e e1 `seqMaybe` checkl_e e2
457 check_e (NegApp e _) = checkl_e e
458 check_e (ExplicitList _ es) = checkl_es es
459 check_e (ExplicitTuple es _) = checkl_es es
460 check_e other = Just other -- Fails
462 checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
465 badRuleLhsErr name lhs bad_e
466 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
467 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
468 ptext SLIT("in left-hand side:") <+> ppr lhs])]
470 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
474 %*********************************************************
476 \subsection{Type, class and iface sig declarations}
478 %*********************************************************
480 @rnTyDecl@ uses the `global name function' to create a new type
481 declaration in which local names have been replaced by their original
482 names, reporting any unknown names.
484 Renaming type variables is a pain. Because they now contain uniques,
485 it is necessary to pass in an association list which maps a parsed
486 tyvar to its @Name@ representation.
487 In some cases (type signatures of values),
488 it is even necessary to go over the type first
489 in order to get the set of tyvars used by it, make an assoc list,
490 and then go over it again to rename the tyvars!
491 However, we can also do some scoping checks at the same time.
494 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
495 = lookupLocatedTopBndrRn name `thenM` \ name' ->
496 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
499 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
500 tcdLName = tycon, tcdTyVars = tyvars,
501 tcdTyPats = typatsMaybe, tcdCons = condecls,
502 tcdKindSig = sig, tcdDerivs = derivs})
503 | isKindSigDecl tydecl -- kind signature of indexed type
504 = rnTySig tydecl bindTyVarsRn
505 | is_vanilla -- Normal Haskell data type decl
506 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
507 -- data type is syntactically illegal
508 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
509 do { tycon' <- if isIdxTyDecl tydecl
510 then lookupLocatedOccRn tycon -- may be imported family
511 else lookupLocatedTopBndrRn tycon
512 ; context' <- rnContext data_doc context
513 ; typats' <- rnTyPats data_doc typatsMaybe
514 ; (derivs', deriv_fvs) <- rn_derivs derivs
515 ; checkDupNames data_doc con_names
516 ; condecls' <- rnConDecls (unLoc tycon') condecls
517 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
518 tcdLName = tycon', tcdTyVars = tyvars',
519 tcdTyPats = typats', tcdKindSig = Nothing,
520 tcdCons = condecls', tcdDerivs = derivs'},
521 delFVs (map hsLTyVarName tyvars') $
522 extractHsCtxtTyNames context' `plusFV`
523 plusFVs (map conDeclFVs condecls') `plusFV`
525 (if isIdxTyDecl tydecl
526 then unitFV (unLoc tycon') -- type instance => use
531 = ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
532 do { tycon' <- if isIdxTyDecl tydecl
533 then lookupLocatedOccRn tycon -- may be imported family
534 else lookupLocatedTopBndrRn tycon
535 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
536 ; tyvars' <- bindTyVarsRn data_doc tyvars
537 (\ tyvars' -> return tyvars')
538 -- For GADTs, the type variables in the declaration
539 -- do not scope over the constructor signatures
540 -- data T a where { T1 :: forall b. b-> b }
541 ; (derivs', deriv_fvs) <- rn_derivs derivs
542 ; checkDupNames data_doc con_names
543 ; condecls' <- rnConDecls (unLoc tycon') condecls
544 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
545 tcdLName = tycon', tcdTyVars = tyvars',
546 tcdTyPats = Nothing, tcdKindSig = sig,
547 tcdCons = condecls', tcdDerivs = derivs'},
548 plusFVs (map conDeclFVs condecls') `plusFV`
550 (if isIdxTyDecl tydecl
551 then unitFV (unLoc tycon') -- type instance => use
555 is_vanilla = case condecls of -- Yuk
557 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
561 none (Just []) = True
564 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
565 con_names = map con_names_helper condecls
567 con_names_helper (L _ c) = con_name c
569 rn_derivs Nothing = returnM (Nothing, emptyFVs)
570 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
571 returnM (Just ds', extractHsTyNames_s ds')
573 rnTyClDecl (tydecl@TyFunction {}) =
574 rnTySig tydecl bindTyVarsRn
576 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
577 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
578 = bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
579 do { name' <- if isIdxTyDecl tydecl
580 then lookupLocatedOccRn name -- may be imported family
581 else lookupLocatedTopBndrRn name
582 ; typats' <- rnTyPats syn_doc typatsMaybe
583 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
584 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
585 tcdTyPats = typats', tcdSynRhs = ty'},
586 delFVs (map hsLTyVarName tyvars') $
588 (if isIdxTyDecl tydecl
589 then unitFV (unLoc name') -- type instance => use
593 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
595 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
596 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
597 tcdMeths = mbinds, tcdATs = ats})
598 = lookupLocatedTopBndrRn cname `thenM` \ cname' ->
600 -- Tyvars scope over superclass context and method signatures
601 bindTyVarsRn cls_doc tyvars ( \ tyvars' ->
602 rnContext cls_doc context `thenM` \ context' ->
603 rnFds cls_doc fds `thenM` \ fds' ->
604 rnATs ats `thenM` \ (ats', ats_fvs) ->
605 renameSigs okClsDclSig sigs `thenM` \ sigs' ->
606 returnM (tyvars', context', fds', (ats', ats_fvs), sigs')
607 ) `thenM` \ (tyvars', context', fds', (ats', ats_fvs), sigs') ->
609 -- Check for duplicates among the associated types
611 at_rdr_names_w_locs = [tcdLName ty | L _ ty <- ats]
613 checkDupNames at_doc at_rdr_names_w_locs `thenM_`
615 -- Check the signatures
616 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
618 sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
620 checkDupNames sig_doc sig_rdr_names_w_locs `thenM_`
621 -- Typechecker is responsible for checking that we only
622 -- give default-method bindings for things in this class.
623 -- The renamer *could* check this for class decls, but can't
624 -- for instance decls.
626 -- The newLocals call is tiresome: given a generic class decl
629 -- op {| x+y |} (Inl a) = ...
630 -- op {| x+y |} (Inr b) = ...
631 -- op {| a*b |} (a*b) = ...
632 -- we want to name both "x" tyvars with the same unique, so that they are
633 -- easy to group together in the typechecker.
634 extendTyVarEnvForMethodBinds tyvars' (
635 getLocalRdrEnv `thenM` \ name_env ->
637 meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
638 gen_rdr_tyvars_w_locs =
639 [ tv | tv <- extractGenericPatTyVars mbinds,
640 not (unLoc tv `elemLocalRdrEnv` name_env) ]
642 checkDupNames meth_doc meth_rdr_names_w_locs `thenM_`
643 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
644 rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds
645 ) `thenM` \ (mbinds', meth_fvs) ->
647 returnM (ClassDecl { tcdCtxt = context', tcdLName = cname',
648 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
649 tcdMeths = mbinds', tcdATs = ats'},
650 delFVs (map hsLTyVarName tyvars') $
651 extractHsCtxtTyNames context' `plusFV`
652 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
653 hsSigsFVs sigs' `plusFV`
657 meth_doc = text "In the default-methods for class" <+> ppr cname
658 cls_doc = text "In the declaration for class" <+> ppr cname
659 sig_doc = text "In the signatures for class" <+> ppr cname
660 at_doc = text "In the associated types for class" <+> ppr cname
662 badGadtStupidTheta tycon
663 = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
664 ptext SLIT("(You can put a context on each contructor, though.)")]
667 %*********************************************************
669 \subsection{Support code for type/data declarations}
671 %*********************************************************
674 -- Although, we are processing type patterns here, all type variables will
675 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
676 -- type declaration to which these patterns belong)
678 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
679 rnTyPats _ Nothing = return Nothing
680 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
682 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
683 rnConDecls tycon condecls
684 = mappM (wrapLocM rnConDecl) condecls
686 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
687 rnConDecl (ConDecl name expl tvs cxt details res_ty)
688 = do { addLocM checkConName name
690 ; new_name <- lookupLocatedTopBndrRn name
691 ; name_env <- getLocalRdrEnv
693 -- For H98 syntax, the tvs are the existential ones
694 -- For GADT syntax, the tvs are all the quantified tyvars
695 -- Hence the 'filter' in the ResTyH98 case only
696 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
697 arg_tys = hsConArgs details
698 implicit_tvs = case res_ty of
699 ResTyH98 -> filter not_in_scope $
701 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
704 Implicit -> userHsTyVarBndrs implicit_tvs
706 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
707 { new_context <- rnContext doc cxt
708 ; new_details <- rnConDetails doc details
709 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
710 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty) }}
712 doc = text "In the definition of data constructor" <+> quotes (ppr name)
713 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
715 rnConResult _ details ResTyH98 = return (details, ResTyH98)
717 rnConResult doc details (ResTyGADT ty) = do
718 ty' <- rnHsSigType doc ty
719 let (arg_tys, res_ty) = splitHsFunType ty'
720 -- We can split it up, now the renamer has dealt with fixities
722 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
723 RecCon fields -> return (details, ResTyGADT ty')
724 InfixCon {} -> panic "rnConResult"
726 rnConDetails doc (PrefixCon tys)
727 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
728 returnM (PrefixCon new_tys)
730 rnConDetails doc (InfixCon ty1 ty2)
731 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
732 rnLHsType doc ty2 `thenM` \ new_ty2 ->
733 returnM (InfixCon new_ty1 new_ty2)
735 rnConDetails doc (RecCon fields)
736 = checkDupNames doc field_names `thenM_`
737 mappM (rnField doc) fields `thenM` \ new_fields ->
738 returnM (RecCon new_fields)
740 field_names = [fld | (fld, _) <- fields]
742 rnField doc (name, ty)
743 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
744 rnLHsType doc ty `thenM` \ new_ty ->
745 returnM (new_name, new_ty)
747 -- Rename kind signatures (signatures of indexed data types/newtypes and
748 -- signatures of type functions)
750 -- * This function is parametrised by the routine handling the index
751 -- variables. On the toplevel, these are defining occurences, whereas they
752 -- are usage occurences for associated types.
754 rnTySig :: TyClDecl RdrName
755 -> (SDoc -> [LHsTyVarBndr RdrName] ->
756 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
757 RnM (TyClDecl Name, FreeVars))
758 -> RnM (TyClDecl Name, FreeVars)
760 rnTySig (tydecl@TyData {tcdCtxt = context, tcdLName = tycon,
761 tcdTyVars = tyvars, tcdTyPats = mb_typats,
762 tcdCons = condecls, tcdKindSig = sig,
765 ASSERT( null condecls ) -- won't have constructors
766 ASSERT( isNothing mb_typats ) -- won't have type patterns
767 ASSERT( isNothing derivs ) -- won't have deriving
768 ASSERT( isJust sig ) -- will have kind signature
769 do { checkM (not . null $ tyvars) $ addErr needOneIdx -- #indexes >= 1
770 ; bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
771 ; tycon' <- lookupLocatedTopBndrRn tycon
772 ; context' <- rnContext (ksig_doc tycon) context
773 ; returnM (TyData {tcdND = tcdND tydecl, tcdCtxt = context',
774 tcdLName = tycon', tcdTyVars = tyvars',
775 tcdTyPats = Nothing, tcdKindSig = sig,
776 tcdCons = [], tcdDerivs = Nothing},
777 delFVs (map hsLTyVarName tyvars') $
778 extractHsCtxtTyNames context')
782 rnTySig (tydecl@TyFunction {tcdLName = tycon, tcdTyVars = tyvars,
785 do { checkM (not . null $ tyvars) $ addErr needOneIdx -- #indexes >= 1
786 ; bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
787 ; tycon' <- lookupLocatedTopBndrRn tycon
788 ; returnM (TyFunction {tcdLName = tycon', tcdTyVars = tyvars',
789 tcdIso = tcdIso tydecl, tcdKind = sig},
793 ksig_doc tycon = text "In the kind signature for" <+> quotes (ppr tycon)
794 needOneIdx = text "Kind signature requires at least one type index"
796 -- Rename associated type declarations (in classes)
798 -- * This can be kind signatures and (default) type function equations.
800 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
801 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
803 rn_at (tydecl@TyData {}) = rnTySig tydecl lookupIdxVars
804 rn_at (tydecl@TyFunction {}) = rnTySig tydecl lookupIdxVars
805 rn_at (tydecl@TySynonym {}) =
807 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
809 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
811 lookupIdxVars _ tyvars cont =
812 do { checkForDups tyvars;
813 ; tyvars' <- mappM lookupIdxVar tyvars
816 -- Type index variables must be class parameters, which are the only
817 -- type variables in scope at this point.
818 lookupIdxVar (L l tyvar) =
820 name' <- lookupOccRn (hsTyVarName tyvar)
821 return $ L l (replaceTyVarName tyvar name')
823 -- Type variable may only occur once.
825 checkForDups [] = return ()
826 checkForDups (L loc tv:ltvs) =
827 do { setSrcSpan loc $
828 when (hsTyVarName tv `ltvElem` ltvs) $
829 addErr (repeatedTyVar tv)
833 rdrName `ltvElem` [] = False
834 rdrName `ltvElem` (L _ tv:ltvs)
835 | rdrName == hsTyVarName tv = True
836 | otherwise = rdrName `ltvElem` ltvs
838 noPatterns = text "Default definition for an associated synonym cannot have"
839 <+> text "type pattern"
841 repeatedTyVar tv = ptext SLIT("Illegal repeated type variable") <+>
844 -- This data decl will parse OK
846 -- treating "a" as the constructor.
847 -- It is really hard to make the parser spot this malformation.
848 -- So the renamer has to check that the constructor is legal
850 -- We can get an operator as the constructor, even in the prefix form:
851 -- data T = :% Int Int
852 -- from interface files, which always print in prefix form
854 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
857 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
861 %*********************************************************
863 \subsection{Support code to rename types}
865 %*********************************************************
868 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
871 = mappM (wrapLocM rn_fds) fds
874 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
875 rnHsTyVars doc tys2 `thenM` \ tys2' ->
876 returnM (tys1', tys2')
878 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
879 rnHsTyvar doc tyvar = lookupOccRn tyvar
883 %*********************************************************
887 %*********************************************************
893 h = ...$(thing "f")...
895 The splice can expand into literally anything, so when we do dependency
896 analysis we must assume that it might mention 'f'. So we simply treat
897 all locally-defined names as mentioned by any splice. This is terribly
898 brutal, but I don't see what else to do. For example, it'll mean
899 that every locally-defined thing will appear to be used, so no unused-binding
900 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
901 and that will crash the type checker because 'f' isn't in scope.
903 Currently, I'm not treating a splice as also mentioning every import,
904 which is a bit inconsistent -- but there are a lot of them. We might
905 thereby get some bogus unused-import warnings, but we won't crash the
906 type checker. Not very satisfactory really.
909 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
910 rnSplice (HsSplice n expr)
911 = do { checkTH expr "splice"
913 ; [n'] <- newLocalsRn [L loc n]
914 ; (expr', fvs) <- rnLExpr expr
916 -- Ugh! See Note [Splices] above
917 ; lcl_rdr <- getLocalRdrEnv
918 ; gbl_rdr <- getGlobalRdrEnv
919 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
921 lcl_names = mkNameSet (occEnvElts lcl_rdr)
923 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
926 checkTH e what = returnM () -- OK
928 checkTH e what -- Raise an error in a stage-1 compiler
929 = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
930 ptext SLIT("illegal in a stage-1 compiler"),