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, newLocalsRn,
27 bindLocatedLocalsFV, bindPatSigTyVarsFV,
28 bindTyVarsRn, extendTyVarEnvFVRn,
29 bindLocalNames, checkDupNames, mapFvRn
33 import HscTypes ( FixityEnv, FixItem(..),
34 Deprecations, Deprecs(..), DeprecTxt, plusDeprecs )
35 import Class ( FunDep )
36 import Name ( Name, nameOccName )
39 import OccName ( occEnvElts )
41 import SrcLoc ( Located(..), unLoc, noLoc )
42 import DynFlags ( DynFlag(..) )
43 import Maybes ( seqMaybe )
44 import Maybe ( isNothing, isJust )
45 import Monad ( liftM, when )
46 import BasicTypes ( Boxity(..) )
49 @rnSourceDecl@ `renames' declarations.
50 It simultaneously performs dependency analysis and precedence parsing.
51 It also does the following error checks:
54 Checks that tyvars are used properly. This includes checking
55 for undefined tyvars, and tyvars in contexts that are ambiguous.
56 (Some of this checking has now been moved to module @TcMonoType@,
57 since we don't have functional dependency information at this point.)
59 Checks that all variable occurences are defined.
61 Checks the @(..)@ etc constraints in the export list.
66 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
68 rnSrcDecls (HsGroup { hs_valds = val_decls,
69 hs_tyclds = tycl_decls,
70 hs_instds = inst_decls,
72 hs_depds = deprec_decls,
73 hs_fords = foreign_decls,
74 hs_defds = default_decls,
75 hs_ruleds = rule_decls })
77 = do { -- Deal with deprecations (returns only the extra deprecations)
78 deprecs <- rnSrcDeprecDecls deprec_decls ;
79 updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
82 -- Deal with top-level fixity decls
83 -- (returns the total new fixity env)
84 rn_fix_decls <- rnSrcFixityDecls fix_decls ;
85 fix_env <- rnSrcFixityDeclsEnv rn_fix_decls ;
86 updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
89 -- Rename other declarations
90 traceRn (text "Start rnmono") ;
91 (rn_val_decls, bind_dus) <- rnTopBinds val_decls ;
92 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
94 -- You might think that we could build proper def/use information
95 -- for type and class declarations, but they can be involved
96 -- in mutual recursion across modules, and we only do the SCC
97 -- analysis for them in the type checker.
98 -- So we content ourselves with gathering uses only; that
99 -- means we'll only report a declaration as unused if it isn't
100 -- mentioned at all. Ah well.
101 (rn_tycl_decls, src_fvs1)
102 <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls ;
103 (rn_inst_decls, src_fvs2)
104 <- mapFvRn (wrapLocFstM rnSrcInstDecl) inst_decls ;
105 (rn_rule_decls, src_fvs3)
106 <- mapFvRn (wrapLocFstM rnHsRuleDecl) rule_decls ;
107 (rn_foreign_decls, src_fvs4)
108 <- mapFvRn (wrapLocFstM rnHsForeignDecl) foreign_decls ;
109 (rn_default_decls, src_fvs5)
110 <- mapFvRn (wrapLocFstM rnDefaultDecl) default_decls ;
113 rn_group = HsGroup { hs_valds = rn_val_decls,
114 hs_tyclds = rn_tycl_decls,
115 hs_instds = rn_inst_decls,
116 hs_fixds = rn_fix_decls,
118 hs_fords = rn_foreign_decls,
119 hs_defds = rn_default_decls,
120 hs_ruleds = rn_rule_decls } ;
122 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3,
123 src_fvs4, src_fvs5] ;
124 src_dus = bind_dus `plusDU` usesOnly other_fvs
125 -- Note: src_dus will contain *uses* for locally-defined types
126 -- and classes, but no *defs* for them. (Because rnTyClDecl
127 -- returns only the uses.) This is a little
128 -- surprising but it doesn't actually matter at all.
131 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
132 traceRn (text "finish Dus" <+> ppr src_dus ) ;
133 tcg_env <- getGblEnv ;
134 return (tcg_env `addTcgDUs` src_dus, rn_group)
137 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
138 rnTyClDecls tycl_decls = do
139 (decls', fvs) <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls
142 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
143 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
147 %*********************************************************
149 Source-code fixity declarations
151 %*********************************************************
154 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
155 rnSrcFixityDecls fix_decls
156 = do fix_decls <- mapM rnFixityDecl fix_decls
157 return (concat fix_decls)
159 rnFixityDecl :: LFixitySig RdrName -> RnM [LFixitySig Name]
160 rnFixityDecl (L loc (FixitySig (L nameLoc rdr_name) fixity))
161 = setSrcSpan nameLoc $
162 -- GHC extension: look up both the tycon and data con
163 -- for con-like things
164 -- If neither are in scope, report an error; otherwise
165 -- add both to the fixity env
166 do names <- lookupLocalDataTcNames rdr_name
167 return [ L loc (FixitySig (L nameLoc name) fixity)
170 rnSrcFixityDeclsEnv :: [LFixitySig Name] -> RnM FixityEnv
171 rnSrcFixityDeclsEnv fix_decls
172 = getGblEnv `thenM` \ gbl_env ->
173 foldlM rnFixityDeclEnv (tcg_fix_env gbl_env)
174 fix_decls `thenM` \ fix_env ->
175 traceRn (text "fixity env" <+> pprFixEnv fix_env) `thenM_`
178 rnFixityDeclEnv :: FixityEnv -> LFixitySig Name -> RnM FixityEnv
179 rnFixityDeclEnv fix_env (L loc (FixitySig (L nameLoc name) fixity))
180 = case lookupNameEnv fix_env name of
181 Just (FixItem _ _ loc')
182 -> do addLocErr (L nameLoc name) (dupFixityDecl loc')
185 -> return (extendNameEnv fix_env name fix_item)
186 where fix_item = FixItem (nameOccName name) fixity nameLoc
188 pprFixEnv :: FixityEnv -> SDoc
190 = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
193 dupFixityDecl loc rdr_name
194 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
195 ptext SLIT("also at ") <+> ppr loc
200 %*********************************************************
202 Source-code deprecations declarations
204 %*********************************************************
206 For deprecations, all we do is check that the names are in scope.
207 It's only imported deprecations, dealt with in RnIfaces, that we
208 gather them together.
211 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
215 rnSrcDeprecDecls decls
216 = mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
217 returnM (DeprecSome (mkNameEnv (concat pairs_s)))
219 rn_deprec (Deprecation rdr_name txt)
220 = lookupLocalDataTcNames rdr_name `thenM` \ names ->
221 returnM [(name, (nameOccName name, txt)) | name <- names]
223 checkModDeprec :: Maybe DeprecTxt -> Deprecations
224 -- Check for a module deprecation; done once at top level
225 checkModDeprec Nothing = NoDeprecs
226 checkModDeprec (Just txt) = DeprecAll txt
229 %*********************************************************
231 \subsection{Source code declarations}
233 %*********************************************************
236 rnDefaultDecl (DefaultDecl tys)
237 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
238 returnM (DefaultDecl tys', fvs)
240 doc_str = text "In a `default' declaration"
243 %*********************************************************
245 \subsection{Foreign declarations}
247 %*********************************************************
250 rnHsForeignDecl (ForeignImport name ty spec)
251 = lookupLocatedTopBndrRn name `thenM` \ name' ->
252 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
253 returnM (ForeignImport name' ty' spec, fvs)
255 rnHsForeignDecl (ForeignExport name ty spec)
256 = lookupLocatedOccRn name `thenM` \ name' ->
257 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
258 returnM (ForeignExport name' ty' spec, fvs )
259 -- NB: a foreign export is an *occurrence site* for name, so
260 -- we add it to the free-variable list. It might, for example,
261 -- be imported from another module
263 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
267 %*********************************************************
269 \subsection{Instance declarations}
271 %*********************************************************
274 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
275 -- Used for both source and interface file decls
276 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
278 -- Rename the associated types
279 -- The typechecker (not the renamer) checks that all
280 -- the declarations are for the right class
282 at_doc = text "In the associated types of an instance declaration"
283 at_names = map (head . tyClDeclNames . unLoc) ats
285 checkDupNames at_doc at_names `thenM_`
286 rnATInsts ats `thenM` \ (ats', at_fvs) ->
288 -- Rename the bindings
289 -- The typechecker (not the renamer) checks that all
290 -- the bindings are for the right class
292 meth_doc = text "In the bindings in an instance declaration"
293 meth_names = collectHsBindLocatedBinders mbinds
294 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
296 checkDupNames meth_doc meth_names `thenM_`
297 extendTyVarEnvForMethodBinds inst_tyvars (
298 -- (Slightly strangely) the forall-d tyvars scope over
299 -- the method bindings too
300 rnMethodBinds cls (\n->[]) -- No scoped tyvars
302 ) `thenM` \ (mbinds', meth_fvs) ->
303 -- Rename the prags and signatures.
304 -- Note that the type variables are not in scope here,
305 -- so that instance Eq a => Eq (T a) where
306 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
309 -- But the (unqualified) method names are in scope
311 binders = collectHsBindBinders mbinds'
312 ok_sig = okInstDclSig (mkNameSet binders)
314 bindLocalNames binders (renameSigs ok_sig uprags) `thenM` \ uprags' ->
316 returnM (InstDecl inst_ty' mbinds' uprags' ats',
317 meth_fvs `plusFV` at_fvs
318 `plusFV` hsSigsFVs uprags'
319 `plusFV` extractHsTyNames inst_ty')
320 -- We return the renamed associated data type declarations so
321 -- that they can be entered into the list of type declarations
322 -- for the binding group, but we also keep a copy in the instance.
323 -- The latter is needed for well-formedness checks in the type
324 -- checker (eg, to ensure that all ATs of the instance actually
325 -- receive a declaration).
326 -- NB: Even the copies in the instance declaration carry copies of
327 -- the instance context after renaming. This is a bit
328 -- strange, but should not matter (and it would be more work
329 -- to remove the context).
332 Renaming of the associated types in instances.
334 * We raise an error if we encounter a kind signature in an instance.
337 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
339 mapFvRn (wrapLocFstM rnATInst) atDecls
341 rnATInst tydecl@TyFunction {} =
345 rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
346 rnATInst tydecl@TyData {} =
348 checkM (not . isKindSigDecl $ tydecl) $ addErr noKindSig
351 panic "RnSource.rnATInsts: not a type declaration"
353 noKindSig = text "Instances cannot have kind signatures"
356 For the method bindings in class and instance decls, we extend the
357 type variable environment iff -fglasgow-exts
360 extendTyVarEnvForMethodBinds tyvars thing_inside
361 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
362 if opt_GlasgowExts then
363 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
369 %*********************************************************
373 %*********************************************************
376 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
377 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
379 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
380 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
382 rnLExpr lhs `thenM` \ (lhs', fv_lhs') ->
383 rnLExpr rhs `thenM` \ (rhs', fv_rhs') ->
385 checkValidRule rule_name ids lhs' fv_lhs' `thenM_`
387 returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
388 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
390 doc = text "In the transformation rule" <+> ftext rule_name
392 get_var (RuleBndr v) = v
393 get_var (RuleBndrSig v _) = v
395 rn_var (RuleBndr (L loc v), id)
396 = returnM (RuleBndr (L loc id), emptyFVs)
397 rn_var (RuleBndrSig (L loc v) t, id)
398 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
399 returnM (RuleBndrSig (L loc id) t', fvs)
402 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
403 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
404 ptext SLIT("does not appear on left hand side")]
407 Note [Rule LHS validity checking]
408 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
409 Check the shape of a transformation rule LHS. Currently we only allow
410 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
411 @forall@'d variables.
413 We used restrict the form of the 'ei' to prevent you writing rules
414 with LHSs with a complicated desugaring (and hence unlikely to match);
415 (e.g. a case expression is not allowed: too elaborate.)
417 But there are legitimate non-trivial args ei, like sections and
418 lambdas. So it seems simmpler not to check at all, and that is why
419 check_e is commented out.
422 checkValidRule rule_name ids lhs' fv_lhs'
423 = do { -- Check for the form of the LHS
424 case (validRuleLhs ids lhs') of
426 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
428 -- Check that LHS vars are all bound
429 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
430 ; mappM (addErr . badRuleVar rule_name) bad_vars }
432 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
434 -- Just e => Not ok, and e is the offending expression
435 validRuleLhs foralls lhs
438 checkl (L loc e) = check e
440 check (OpApp e1 op _ e2) = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
441 check (HsApp e1 e2) = checkl e1 `seqMaybe` checkl_e e2
442 check (HsVar v) | v `notElem` foralls = Nothing
443 check other = Just other -- Failure
446 checkl_e (L loc e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
448 {- Commented out; see Note [Rule LHS validity checking] above
449 check_e (HsVar v) = Nothing
450 check_e (HsPar e) = checkl_e e
451 check_e (HsLit e) = Nothing
452 check_e (HsOverLit e) = Nothing
454 check_e (OpApp e1 op _ e2) = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
455 check_e (HsApp e1 e2) = checkl_e e1 `seqMaybe` checkl_e e2
456 check_e (NegApp e _) = checkl_e e
457 check_e (ExplicitList _ es) = checkl_es es
458 check_e (ExplicitTuple es _) = checkl_es es
459 check_e other = Just other -- Fails
461 checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
464 badRuleLhsErr name lhs bad_e
465 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
466 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
467 ptext SLIT("in left-hand side:") <+> ppr lhs])]
469 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
473 %*********************************************************
475 \subsection{Type, class and iface sig declarations}
477 %*********************************************************
479 @rnTyDecl@ uses the `global name function' to create a new type
480 declaration in which local names have been replaced by their original
481 names, reporting any unknown names.
483 Renaming type variables is a pain. Because they now contain uniques,
484 it is necessary to pass in an association list which maps a parsed
485 tyvar to its @Name@ representation.
486 In some cases (type signatures of values),
487 it is even necessary to go over the type first
488 in order to get the set of tyvars used by it, make an assoc list,
489 and then go over it again to rename the tyvars!
490 However, we can also do some scoping checks at the same time.
493 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
494 = lookupLocatedTopBndrRn name `thenM` \ name' ->
495 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
498 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
499 tcdLName = tycon, tcdTyVars = tyvars,
500 tcdTyPats = typatsMaybe, tcdCons = condecls,
501 tcdKindSig = sig, tcdDerivs = derivs})
502 | isKindSigDecl tydecl -- kind signature of indexed type
503 = rnTySig tydecl bindTyVarsRn
504 | is_vanilla -- Normal Haskell data type decl
505 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
506 -- data type is syntactically illegal
507 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
508 do { tycon' <- if isIdxTyDecl tydecl
509 then lookupLocatedOccRn tycon -- may be imported family
510 else lookupLocatedTopBndrRn tycon
511 ; context' <- rnContext data_doc context
512 ; typats' <- rnTyPats data_doc typatsMaybe
513 ; (derivs', deriv_fvs) <- rn_derivs derivs
514 ; checkDupNames data_doc con_names
515 ; condecls' <- rnConDecls (unLoc tycon') condecls
516 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
517 tcdLName = tycon', tcdTyVars = tyvars',
518 tcdTyPats = typats', tcdKindSig = Nothing,
519 tcdCons = condecls', tcdDerivs = derivs'},
520 delFVs (map hsLTyVarName tyvars') $
521 extractHsCtxtTyNames context' `plusFV`
522 plusFVs (map conDeclFVs condecls') `plusFV`
524 (if isIdxTyDecl tydecl
525 then unitFV (unLoc tycon') -- type instance => use
530 = ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
531 do { tycon' <- if isIdxTyDecl tydecl
532 then lookupLocatedOccRn tycon -- may be imported family
533 else lookupLocatedTopBndrRn tycon
534 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
535 ; tyvars' <- bindTyVarsRn data_doc tyvars
536 (\ tyvars' -> return tyvars')
537 -- For GADTs, the type variables in the declaration
538 -- do not scope over the constructor signatures
539 -- data T a where { T1 :: forall b. b-> b }
540 ; (derivs', deriv_fvs) <- rn_derivs derivs
541 ; checkDupNames data_doc con_names
542 ; condecls' <- rnConDecls (unLoc tycon') condecls
543 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
544 tcdLName = tycon', tcdTyVars = tyvars',
545 tcdTyPats = Nothing, tcdKindSig = sig,
546 tcdCons = condecls', tcdDerivs = derivs'},
547 plusFVs (map conDeclFVs condecls') `plusFV`
549 (if isIdxTyDecl tydecl
550 then unitFV (unLoc tycon') -- type instance => use
554 is_vanilla = case condecls of -- Yuk
556 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
560 none (Just []) = True
563 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
564 con_names = map con_names_helper condecls
566 con_names_helper (L _ c) = con_name c
568 rn_derivs Nothing = returnM (Nothing, emptyFVs)
569 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
570 returnM (Just ds', extractHsTyNames_s ds')
572 rnTyClDecl (tydecl@TyFunction {}) =
573 rnTySig tydecl bindTyVarsRn
575 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
576 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
577 = bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
578 do { name' <- if isIdxTyDecl tydecl
579 then lookupLocatedOccRn name -- may be imported family
580 else lookupLocatedTopBndrRn name
581 ; typats' <- rnTyPats syn_doc typatsMaybe
582 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
583 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
584 tcdTyPats = typats', tcdSynRhs = ty'},
585 delFVs (map hsLTyVarName tyvars') $
587 (if isIdxTyDecl tydecl
588 then unitFV (unLoc name') -- type instance => use
592 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
594 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
595 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
596 tcdMeths = mbinds, tcdATs = ats})
597 = lookupLocatedTopBndrRn cname `thenM` \ cname' ->
599 -- Tyvars scope over superclass context and method signatures
600 bindTyVarsRn cls_doc tyvars ( \ tyvars' ->
601 rnContext cls_doc context `thenM` \ context' ->
602 rnFds cls_doc fds `thenM` \ fds' ->
603 rnATs ats `thenM` \ (ats', ats_fvs) ->
604 renameSigs okClsDclSig sigs `thenM` \ sigs' ->
605 returnM (tyvars', context', fds', (ats', ats_fvs), sigs')
606 ) `thenM` \ (tyvars', context', fds', (ats', ats_fvs), sigs') ->
608 -- Check for duplicates among the associated types
610 at_rdr_names_w_locs = [tcdLName ty | L _ ty <- ats]
612 checkDupNames at_doc at_rdr_names_w_locs `thenM_`
614 -- Check the signatures
615 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
617 sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
619 checkDupNames sig_doc sig_rdr_names_w_locs `thenM_`
620 -- Typechecker is responsible for checking that we only
621 -- give default-method bindings for things in this class.
622 -- The renamer *could* check this for class decls, but can't
623 -- for instance decls.
625 -- The newLocals call is tiresome: given a generic class decl
628 -- op {| x+y |} (Inl a) = ...
629 -- op {| x+y |} (Inr b) = ...
630 -- op {| a*b |} (a*b) = ...
631 -- we want to name both "x" tyvars with the same unique, so that they are
632 -- easy to group together in the typechecker.
633 extendTyVarEnvForMethodBinds tyvars' (
634 getLocalRdrEnv `thenM` \ name_env ->
636 meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
637 gen_rdr_tyvars_w_locs =
638 [ tv | tv <- extractGenericPatTyVars mbinds,
639 not (unLoc tv `elemLocalRdrEnv` name_env) ]
641 checkDupNames meth_doc meth_rdr_names_w_locs `thenM_`
642 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
643 rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds
644 ) `thenM` \ (mbinds', meth_fvs) ->
646 returnM (ClassDecl { tcdCtxt = context', tcdLName = cname',
647 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
648 tcdMeths = mbinds', tcdATs = ats'},
649 delFVs (map hsLTyVarName tyvars') $
650 extractHsCtxtTyNames context' `plusFV`
651 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
652 hsSigsFVs sigs' `plusFV`
656 meth_doc = text "In the default-methods for class" <+> ppr cname
657 cls_doc = text "In the declaration for class" <+> ppr cname
658 sig_doc = text "In the signatures for class" <+> ppr cname
659 at_doc = text "In the associated types for class" <+> ppr cname
661 badGadtStupidTheta tycon
662 = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
663 ptext SLIT("(You can put a context on each contructor, though.)")]
666 %*********************************************************
668 \subsection{Support code for type/data declarations}
670 %*********************************************************
673 -- Although, we are processing type patterns here, all type variables will
674 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
675 -- type declaration to which these patterns belong)
677 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
678 rnTyPats _ Nothing = return Nothing
679 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
681 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
682 rnConDecls tycon condecls
683 = mappM (wrapLocM rnConDecl) condecls
685 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
686 rnConDecl (ConDecl name expl tvs cxt details res_ty)
687 = do { addLocM checkConName name
689 ; new_name <- lookupLocatedTopBndrRn name
690 ; name_env <- getLocalRdrEnv
692 -- For H98 syntax, the tvs are the existential ones
693 -- For GADT syntax, the tvs are all the quantified tyvars
694 -- Hence the 'filter' in the ResTyH98 case only
695 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
696 arg_tys = hsConArgs details
697 implicit_tvs = case res_ty of
698 ResTyH98 -> filter not_in_scope $
700 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
703 Implicit -> userHsTyVarBndrs implicit_tvs
705 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
706 { new_context <- rnContext doc cxt
707 ; new_details <- rnConDetails doc details
708 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
709 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty) }}
711 doc = text "In the definition of data constructor" <+> quotes (ppr name)
712 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
714 rnConResult _ details ResTyH98 = return (details, ResTyH98)
716 rnConResult doc details (ResTyGADT ty) = do
717 ty' <- rnHsSigType doc ty
718 let (arg_tys, res_ty) = splitHsFunType ty'
719 -- We can split it up, now the renamer has dealt with fixities
721 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
722 RecCon fields -> return (details, ResTyGADT ty')
723 InfixCon {} -> panic "rnConResult"
725 rnConDetails doc (PrefixCon tys)
726 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
727 returnM (PrefixCon new_tys)
729 rnConDetails doc (InfixCon ty1 ty2)
730 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
731 rnLHsType doc ty2 `thenM` \ new_ty2 ->
732 returnM (InfixCon new_ty1 new_ty2)
734 rnConDetails doc (RecCon fields)
735 = checkDupNames doc field_names `thenM_`
736 mappM (rnField doc) fields `thenM` \ new_fields ->
737 returnM (RecCon new_fields)
739 field_names = [fld | (fld, _) <- fields]
741 rnField doc (name, ty)
742 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
743 rnLHsType doc ty `thenM` \ new_ty ->
744 returnM (new_name, new_ty)
746 -- Rename kind signatures (signatures of indexed data types/newtypes and
747 -- signatures of type functions)
749 -- * This function is parametrised by the routine handling the index
750 -- variables. On the toplevel, these are defining occurences, whereas they
751 -- are usage occurences for associated types.
753 rnTySig :: TyClDecl RdrName
754 -> (SDoc -> [LHsTyVarBndr RdrName] ->
755 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
756 RnM (TyClDecl Name, FreeVars))
757 -> RnM (TyClDecl Name, FreeVars)
759 rnTySig (tydecl@TyData {tcdCtxt = context, tcdLName = tycon,
760 tcdTyVars = tyvars, tcdTyPats = mb_typats,
761 tcdCons = condecls, tcdKindSig = sig,
764 ASSERT( null condecls ) -- won't have constructors
765 ASSERT( isNothing mb_typats ) -- won't have type patterns
766 ASSERT( isNothing derivs ) -- won't have deriving
767 ASSERT( isJust sig ) -- will have kind signature
768 do { checkM (not . null $ tyvars) $ addErr needOneIdx -- #indexes >= 1
769 ; bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
770 ; tycon' <- lookupLocatedTopBndrRn tycon
771 ; context' <- rnContext (ksig_doc tycon) context
772 ; returnM (TyData {tcdND = tcdND tydecl, tcdCtxt = context',
773 tcdLName = tycon', tcdTyVars = tyvars',
774 tcdTyPats = Nothing, tcdKindSig = sig,
775 tcdCons = [], tcdDerivs = Nothing},
776 delFVs (map hsLTyVarName tyvars') $
777 extractHsCtxtTyNames context')
781 rnTySig (tydecl@TyFunction {tcdLName = tycon, tcdTyVars = tyvars,
784 do { checkM (not . null $ tyvars) $ addErr needOneIdx -- #indexes >= 1
785 ; bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
786 ; tycon' <- lookupLocatedTopBndrRn tycon
787 ; returnM (TyFunction {tcdLName = tycon', tcdTyVars = tyvars',
788 tcdIso = tcdIso tydecl, tcdKind = sig},
792 ksig_doc tycon = text "In the kind signature for" <+> quotes (ppr tycon)
793 needOneIdx = text "Kind signature requires at least one type index"
795 -- Rename associated type declarations (in classes)
797 -- * This can be kind signatures and (default) type function equations.
799 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
800 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
802 rn_at (tydecl@TyData {}) = rnTySig tydecl lookupIdxVars
803 rn_at (tydecl@TyFunction {}) = rnTySig tydecl lookupIdxVars
804 rn_at (tydecl@TySynonym {}) =
806 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
808 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
810 lookupIdxVars _ tyvars cont =
811 do { checkForDups tyvars;
812 ; tyvars' <- mappM lookupIdxVar tyvars
815 -- Type index variables must be class parameters, which are the only
816 -- type variables in scope at this point.
817 lookupIdxVar (L l tyvar) =
819 name' <- lookupOccRn (hsTyVarName tyvar)
820 return $ L l (replaceTyVarName tyvar name')
822 -- Type variable may only occur once.
824 checkForDups [] = return ()
825 checkForDups (L loc tv:ltvs) =
826 do { setSrcSpan loc $
827 when (hsTyVarName tv `ltvElem` ltvs) $
828 addErr (repeatedTyVar tv)
832 rdrName `ltvElem` [] = False
833 rdrName `ltvElem` (L _ tv:ltvs)
834 | rdrName == hsTyVarName tv = True
835 | otherwise = rdrName `ltvElem` ltvs
837 noPatterns = text "Default definition for an associated synonym cannot have"
838 <+> text "type pattern"
840 repeatedTyVar tv = ptext SLIT("Illegal repeated type variable") <+>
843 -- This data decl will parse OK
845 -- treating "a" as the constructor.
846 -- It is really hard to make the parser spot this malformation.
847 -- So the renamer has to check that the constructor is legal
849 -- We can get an operator as the constructor, even in the prefix form:
850 -- data T = :% Int Int
851 -- from interface files, which always print in prefix form
853 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
856 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
860 %*********************************************************
862 \subsection{Support code to rename types}
864 %*********************************************************
867 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
870 = mappM (wrapLocM rn_fds) fds
873 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
874 rnHsTyVars doc tys2 `thenM` \ tys2' ->
875 returnM (tys1', tys2')
877 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
878 rnHsTyvar doc tyvar = lookupOccRn tyvar
882 %*********************************************************
886 %*********************************************************
892 h = ...$(thing "f")...
894 The splice can expand into literally anything, so when we do dependency
895 analysis we must assume that it might mention 'f'. So we simply treat
896 all locally-defined names as mentioned by any splice. This is terribly
897 brutal, but I don't see what else to do. For example, it'll mean
898 that every locally-defined thing will appear to be used, so no unused-binding
899 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
900 and that will crash the type checker because 'f' isn't in scope.
902 Currently, I'm not treating a splice as also mentioning every import,
903 which is a bit inconsistent -- but there are a lot of them. We might
904 thereby get some bogus unused-import warnings, but we won't crash the
905 type checker. Not very satisfactory really.
908 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
909 rnSplice (HsSplice n expr)
910 = do { checkTH expr "splice"
912 ; [n'] <- newLocalsRn [L loc n]
913 ; (expr', fvs) <- rnLExpr expr
915 -- Ugh! See Note [Splices] above
916 ; lcl_rdr <- getLocalRdrEnv
917 ; gbl_rdr <- getGlobalRdrEnv
918 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
920 lcl_names = mkNameSet (occEnvElts lcl_rdr)
922 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
925 checkTH e what = returnM () -- OK
927 checkTH e what -- Raise an error in a stage-1 compiler
928 = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
929 ptext SLIT("illegal in a stage-1 compiler"),