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 in 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' <- lookupLocatedTopBndrRn tycon
510 ; context' <- rnContext data_doc context
511 ; typats' <- rnTyPats data_doc typatsMaybe
512 ; (derivs', deriv_fvs) <- rn_derivs derivs
513 ; checkDupNames data_doc con_names
514 ; condecls' <- rnConDecls (unLoc tycon') condecls
515 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
516 tcdLName = tycon', tcdTyVars = tyvars',
517 tcdTyPats = typats', tcdKindSig = Nothing,
518 tcdCons = condecls', tcdDerivs = derivs'},
519 delFVs (map hsLTyVarName tyvars') $
520 extractHsCtxtTyNames context' `plusFV`
521 plusFVs (map conDeclFVs condecls') `plusFV`
525 = ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
526 do { tycon' <- lookupLocatedTopBndrRn tycon
527 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
528 ; tyvars' <- bindTyVarsRn data_doc tyvars
529 (\ tyvars' -> return tyvars')
530 -- For GADTs, the type variables in the declaration
531 -- do not scope over the constructor signatures
532 -- data T a where { T1 :: forall b. b-> b }
533 ; (derivs', deriv_fvs) <- rn_derivs derivs
534 ; checkDupNames data_doc con_names
535 ; condecls' <- rnConDecls (unLoc tycon') condecls
536 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
537 tcdLName = tycon', tcdTyVars = tyvars',
538 tcdTyPats = Nothing, tcdKindSig = sig,
539 tcdCons = condecls', tcdDerivs = derivs'},
540 plusFVs (map conDeclFVs condecls') `plusFV` deriv_fvs) }
543 is_vanilla = case condecls of -- Yuk
545 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
549 none (Just []) = True
552 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
553 con_names = map con_names_helper condecls
555 con_names_helper (L _ c) = con_name c
557 rn_derivs Nothing = returnM (Nothing, emptyFVs)
558 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
559 returnM (Just ds', extractHsTyNames_s ds')
561 rnTyClDecl (tydecl@TyFunction {}) =
562 rnTySig tydecl bindTyVarsRn
564 rnTyClDecl (TySynonym {tcdLName = name, tcdTyVars = tyvars,
565 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
566 = bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
567 do { name' <- lookupLocatedTopBndrRn name
568 ; typats' <- rnTyPats syn_doc typatsMaybe
569 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
570 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
571 tcdTyPats = typats', tcdSynRhs = ty'},
572 delFVs (map hsLTyVarName tyvars') fvs) }
574 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
576 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
577 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
578 tcdMeths = mbinds, tcdATs = ats})
579 = lookupLocatedTopBndrRn cname `thenM` \ cname' ->
581 -- Tyvars scope over superclass context and method signatures
582 bindTyVarsRn cls_doc tyvars ( \ tyvars' ->
583 rnContext cls_doc context `thenM` \ context' ->
584 rnFds cls_doc fds `thenM` \ fds' ->
585 rnATs ats `thenM` \ (ats', ats_fvs) ->
586 renameSigs okClsDclSig sigs `thenM` \ sigs' ->
587 returnM (tyvars', context', fds', (ats', ats_fvs), sigs')
588 ) `thenM` \ (tyvars', context', fds', (ats', ats_fvs), sigs') ->
590 -- Check for duplicates among the associated types
592 at_rdr_names_w_locs = [tcdLName ty | L _ ty <- ats]
594 checkDupNames at_doc at_rdr_names_w_locs `thenM_`
596 -- Check the signatures
597 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
599 sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
601 checkDupNames sig_doc sig_rdr_names_w_locs `thenM_`
602 -- Typechecker is responsible for checking that we only
603 -- give default-method bindings for things in this class.
604 -- The renamer *could* check this for class decls, but can't
605 -- for instance decls.
607 -- The newLocals call is tiresome: given a generic class decl
610 -- op {| x+y |} (Inl a) = ...
611 -- op {| x+y |} (Inr b) = ...
612 -- op {| a*b |} (a*b) = ...
613 -- we want to name both "x" tyvars with the same unique, so that they are
614 -- easy to group together in the typechecker.
615 extendTyVarEnvForMethodBinds tyvars' (
616 getLocalRdrEnv `thenM` \ name_env ->
618 meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
619 gen_rdr_tyvars_w_locs =
620 [ tv | tv <- extractGenericPatTyVars mbinds,
621 not (unLoc tv `elemLocalRdrEnv` name_env) ]
623 checkDupNames meth_doc meth_rdr_names_w_locs `thenM_`
624 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
625 rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds
626 ) `thenM` \ (mbinds', meth_fvs) ->
628 returnM (ClassDecl { tcdCtxt = context', tcdLName = cname',
629 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
630 tcdMeths = mbinds', tcdATs = ats'},
631 delFVs (map hsLTyVarName tyvars') $
632 extractHsCtxtTyNames context' `plusFV`
633 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
634 hsSigsFVs sigs' `plusFV`
638 meth_doc = text "In the default-methods for class" <+> ppr cname
639 cls_doc = text "In the declaration for class" <+> ppr cname
640 sig_doc = text "In the signatures for class" <+> ppr cname
641 at_doc = text "In the associated types for class" <+> ppr cname
643 badGadtStupidTheta tycon
644 = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
645 ptext SLIT("(You can put a context on each contructor, though.)")]
648 %*********************************************************
650 \subsection{Support code for type/data declarations}
652 %*********************************************************
655 -- Although, we are processing type patterns here, all type variables will
656 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
657 -- type declaration to which these patterns belong)
659 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
660 rnTyPats _ Nothing = return Nothing
661 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
663 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
664 rnConDecls tycon condecls
665 = mappM (wrapLocM rnConDecl) condecls
667 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
668 rnConDecl (ConDecl name expl tvs cxt details res_ty)
669 = do { addLocM checkConName name
671 ; new_name <- lookupLocatedTopBndrRn name
672 ; name_env <- getLocalRdrEnv
674 -- For H98 syntax, the tvs are the existential ones
675 -- For GADT syntax, the tvs are all the quantified tyvars
676 -- Hence the 'filter' in the ResTyH98 case only
677 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
678 arg_tys = hsConArgs details
679 implicit_tvs = case res_ty of
680 ResTyH98 -> filter not_in_scope $
682 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
685 Implicit -> userHsTyVarBndrs implicit_tvs
687 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
688 { new_context <- rnContext doc cxt
689 ; new_details <- rnConDetails doc details
690 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
691 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty) }}
693 doc = text "In the definition of data constructor" <+> quotes (ppr name)
694 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
696 rnConResult _ details ResTyH98 = return (details, ResTyH98)
698 rnConResult doc details (ResTyGADT ty) = do
699 ty' <- rnHsSigType doc ty
700 let (arg_tys, res_ty) = splitHsFunType ty'
701 -- We can split it up, now the renamer has dealt with fixities
703 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
704 RecCon fields -> return (details, ResTyGADT ty')
705 InfixCon {} -> panic "rnConResult"
707 rnConDetails doc (PrefixCon tys)
708 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
709 returnM (PrefixCon new_tys)
711 rnConDetails doc (InfixCon ty1 ty2)
712 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
713 rnLHsType doc ty2 `thenM` \ new_ty2 ->
714 returnM (InfixCon new_ty1 new_ty2)
716 rnConDetails doc (RecCon fields)
717 = checkDupNames doc field_names `thenM_`
718 mappM (rnField doc) fields `thenM` \ new_fields ->
719 returnM (RecCon new_fields)
721 field_names = [fld | (fld, _) <- fields]
723 rnField doc (name, ty)
724 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
725 rnLHsType doc ty `thenM` \ new_ty ->
726 returnM (new_name, new_ty)
728 -- Rename kind signatures (signatures of indexed data types/newtypes and
729 -- signatures of type functions)
731 -- * This function is parametrised by the routine handling the index
732 -- variables. On the toplevel, these are defining occurences, whereas they
733 -- are usage occurences for associated types.
735 rnTySig :: TyClDecl RdrName
736 -> (SDoc -> [LHsTyVarBndr RdrName] ->
737 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
738 RnM (TyClDecl Name, FreeVars))
739 -> RnM (TyClDecl Name, FreeVars)
741 rnTySig (tydecl@TyData {tcdCtxt = context, tcdLName = tycon,
742 tcdTyVars = tyvars, tcdTyPats = mb_typats,
743 tcdCons = condecls, tcdKindSig = sig,
746 ASSERT( null condecls ) -- won't have constructors
747 ASSERT( isNothing mb_typats ) -- won't have type patterns
748 ASSERT( isNothing derivs ) -- won't have deriving
749 ASSERT( isJust sig ) -- will have kind signature
750 do { checkM (not . null $ tyvars) $ addErr needOneIdx -- #indexes >= 1
751 ; bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
752 ; tycon' <- lookupLocatedTopBndrRn tycon
753 ; context' <- rnContext (ksig_doc tycon) context
754 ; returnM (TyData {tcdND = tcdND tydecl, tcdCtxt = context',
755 tcdLName = tycon', tcdTyVars = tyvars',
756 tcdTyPats = Nothing, tcdKindSig = sig,
757 tcdCons = [], tcdDerivs = Nothing},
758 delFVs (map hsLTyVarName tyvars') $
759 extractHsCtxtTyNames context') } }
762 rnTySig (tydecl@TyFunction {tcdLName = tycon, tcdTyVars = tyvars,
765 do { checkM (not . null $ tyvars) $ addErr needOneIdx -- #indexes >= 1
766 ; bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
767 ; tycon' <- lookupLocatedTopBndrRn tycon
768 ; returnM (TyFunction {tcdLName = tycon', tcdTyVars = tyvars',
769 tcdIso = tcdIso tydecl, tcdKind = sig},
772 ksig_doc tycon = text "In the kind signature for" <+> quotes (ppr tycon)
773 needOneIdx = text "Kind signature requires at least one type index"
775 -- Rename associated type declarations (in classes)
777 -- * This can be kind signatures and (default) type function equations.
779 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
780 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
782 rn_at (tydecl@TyData {}) = rnTySig tydecl lookupIdxVars
783 rn_at (tydecl@TyFunction {}) = rnTySig tydecl lookupIdxVars
784 rn_at (tydecl@TySynonym {}) =
786 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
788 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
790 lookupIdxVars _ tyvars cont =
791 do { checkForDups tyvars;
792 ; tyvars' <- mappM lookupIdxVar tyvars
795 -- Type index variables must be class parameters, which are the only
796 -- type variables in scope at this point.
797 lookupIdxVar (L l tyvar) =
799 name' <- lookupOccRn (hsTyVarName tyvar)
800 return $ L l (replaceTyVarName tyvar name')
802 -- Type variable may only occur once.
804 checkForDups [] = return ()
805 checkForDups (L loc tv:ltvs) =
806 do { setSrcSpan loc $
807 when (hsTyVarName tv `ltvElem` ltvs) $
808 addErr (repeatedTyVar tv)
812 rdrName `ltvElem` [] = False
813 rdrName `ltvElem` (L _ tv:ltvs)
814 | rdrName == hsTyVarName tv = True
815 | otherwise = rdrName `ltvElem` ltvs
817 noPatterns = text "Default definition for an associated synonym cannot have"
818 <+> text "type pattern"
820 repeatedTyVar tv = ptext SLIT("Illegal repeated type variable") <+>
823 -- This data decl will parse OK
825 -- treating "a" as the constructor.
826 -- It is really hard to make the parser spot this malformation.
827 -- So the renamer has to check that the constructor is legal
829 -- We can get an operator as the constructor, even in the prefix form:
830 -- data T = :% Int Int
831 -- from interface files, which always print in prefix form
833 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
836 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
840 %*********************************************************
842 \subsection{Support code to rename types}
844 %*********************************************************
847 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
850 = mappM (wrapLocM rn_fds) fds
853 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
854 rnHsTyVars doc tys2 `thenM` \ tys2' ->
855 returnM (tys1', tys2')
857 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
858 rnHsTyvar doc tyvar = lookupOccRn tyvar
862 %*********************************************************
866 %*********************************************************
872 h = ...$(thing "f")...
874 The splice can expand into literally anything, so when we do dependency
875 analysis we must assume that it might mention 'f'. So we simply treat
876 all locally-defined names as mentioned by any splice. This is terribly
877 brutal, but I don't see what else to do. For example, it'll mean
878 that every locally-defined thing will appear to be used, so no unused-binding
879 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
880 and that will crash the type checker because 'f' isn't in scope.
882 Currently, I'm not treating a splice as also mentioning every import,
883 which is a bit inconsistent -- but there are a lot of them. We might
884 thereby get some bogus unused-import warnings, but we won't crash the
885 type checker. Not very satisfactory really.
888 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
889 rnSplice (HsSplice n expr)
890 = do { checkTH expr "splice"
892 ; [n'] <- newLocalsRn [L loc n]
893 ; (expr', fvs) <- rnLExpr expr
895 -- Ugh! See Note [Splices] above
896 ; lcl_rdr <- getLocalRdrEnv
897 ; gbl_rdr <- getGlobalRdrEnv
898 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
900 lcl_names = mkNameSet (occEnvElts lcl_rdr)
902 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
905 checkTH e what = returnM () -- OK
907 checkTH e what -- Raise an error in a stage-1 compiler
908 = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
909 ptext SLIT("illegal in a stage-1 compiler"),