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 )
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 ;
115 [ats | L _ (InstDecl _ _ _ ats) <- rn_inst_decls] ;
116 rn_group = HsGroup { hs_valds = rn_val_decls,
117 hs_tyclds = rn_tycl_decls ++ rn_at_decls,
118 hs_instds = rn_inst_decls,
119 hs_fixds = rn_fix_decls,
121 hs_fords = rn_foreign_decls,
122 hs_defds = rn_default_decls,
123 hs_ruleds = rn_rule_decls } ;
125 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3,
126 src_fvs4, src_fvs5] ;
127 src_dus = bind_dus `plusDU` usesOnly other_fvs
128 -- Note: src_dus will contain *uses* for locally-defined types
129 -- and classes, but no *defs* for them. (Because rnTyClDecl
130 -- returns only the uses.) This is a little
131 -- surprising but it doesn't actually matter at all.
134 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
135 traceRn (text "finish Dus" <+> ppr src_dus ) ;
136 tcg_env <- getGblEnv ;
137 return (tcg_env `addTcgDUs` src_dus, rn_group)
140 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
141 rnTyClDecls tycl_decls = do
142 (decls', fvs) <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls
145 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
146 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
150 %*********************************************************
152 Source-code fixity declarations
154 %*********************************************************
157 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
158 rnSrcFixityDecls fix_decls
159 = do fix_decls <- mapM rnFixityDecl fix_decls
160 return (concat fix_decls)
162 rnFixityDecl :: LFixitySig RdrName -> RnM [LFixitySig Name]
163 rnFixityDecl (L loc (FixitySig (L nameLoc rdr_name) fixity))
164 = setSrcSpan nameLoc $
165 -- GHC extension: look up both the tycon and data con
166 -- for con-like things
167 -- If neither are in scope, report an error; otherwise
168 -- add both to the fixity env
169 do names <- lookupLocalDataTcNames rdr_name
170 return [ L loc (FixitySig (L nameLoc name) fixity)
173 rnSrcFixityDeclsEnv :: [LFixitySig Name] -> RnM FixityEnv
174 rnSrcFixityDeclsEnv fix_decls
175 = getGblEnv `thenM` \ gbl_env ->
176 foldlM rnFixityDeclEnv (tcg_fix_env gbl_env)
177 fix_decls `thenM` \ fix_env ->
178 traceRn (text "fixity env" <+> pprFixEnv fix_env) `thenM_`
181 rnFixityDeclEnv :: FixityEnv -> LFixitySig Name -> RnM FixityEnv
182 rnFixityDeclEnv fix_env (L loc (FixitySig (L nameLoc name) fixity))
183 = case lookupNameEnv fix_env name of
184 Just (FixItem _ _ loc')
185 -> do addLocErr (L nameLoc name) (dupFixityDecl loc')
188 -> return (extendNameEnv fix_env name fix_item)
189 where fix_item = FixItem (nameOccName name) fixity nameLoc
191 pprFixEnv :: FixityEnv -> SDoc
193 = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
196 dupFixityDecl loc rdr_name
197 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
198 ptext SLIT("also at ") <+> ppr loc
203 %*********************************************************
205 Source-code deprecations declarations
207 %*********************************************************
209 For deprecations, all we do is check that the names are in scope.
210 It's only imported deprecations, dealt with in RnIfaces, that we
211 gather them together.
214 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
218 rnSrcDeprecDecls decls
219 = mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
220 returnM (DeprecSome (mkNameEnv (concat pairs_s)))
222 rn_deprec (Deprecation rdr_name txt)
223 = lookupLocalDataTcNames rdr_name `thenM` \ names ->
224 returnM [(name, (nameOccName name, txt)) | name <- names]
226 checkModDeprec :: Maybe DeprecTxt -> Deprecations
227 -- Check for a module deprecation; done once at top level
228 checkModDeprec Nothing = NoDeprecs
229 checkModDeprec (Just txt) = DeprecAll txt
232 %*********************************************************
234 \subsection{Source code declarations}
236 %*********************************************************
239 rnDefaultDecl (DefaultDecl tys)
240 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
241 returnM (DefaultDecl tys', fvs)
243 doc_str = text "In a `default' declaration"
246 %*********************************************************
248 \subsection{Foreign declarations}
250 %*********************************************************
253 rnHsForeignDecl (ForeignImport name ty spec)
254 = lookupLocatedTopBndrRn name `thenM` \ name' ->
255 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
256 returnM (ForeignImport name' ty' spec, fvs)
258 rnHsForeignDecl (ForeignExport name ty spec)
259 = lookupLocatedOccRn name `thenM` \ name' ->
260 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
261 returnM (ForeignExport name' ty' spec, fvs )
262 -- NB: a foreign export is an *occurrence site* for name, so
263 -- we add it to the free-variable list. It might, for example,
264 -- be imported from another module
266 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
270 %*********************************************************
272 \subsection{Instance declarations}
274 %*********************************************************
277 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
278 -- Used for both source and interface file decls
279 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
281 -- Rename the associated types
282 -- The typechecker (not the renamer) checks that all
283 -- the declarations are for the right class
285 at_doc = text "In the associated types in an instance declaration"
286 at_names = map (head . tyClDeclNames . unLoc) ats
287 (_, rdrCtxt, _, _) = splitHsInstDeclTy (unLoc inst_ty)
289 checkDupNames at_doc at_names `thenM_`
290 rnATDefs rdrCtxt ats `thenM` \ (ats', at_fvs) ->
292 -- Rename the bindings
293 -- The typechecker (not the renamer) checks that all
294 -- the bindings are for the right class
296 meth_doc = text "In the bindings in an instance declaration"
297 meth_names = collectHsBindLocatedBinders mbinds
298 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
300 checkDupNames meth_doc meth_names `thenM_`
301 extendTyVarEnvForMethodBinds inst_tyvars (
302 -- (Slightly strangely) the forall-d tyvars scope over
303 -- the method bindings too
304 rnMethodBinds cls (\n->[]) -- No scoped tyvars
306 ) `thenM` \ (mbinds', meth_fvs) ->
307 -- Rename the prags and signatures.
308 -- Note that the type variables are not in scope here,
309 -- so that instance Eq a => Eq (T a) where
310 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
313 -- But the (unqualified) method names are in scope
315 binders = collectHsBindBinders mbinds'
316 ok_sig = okInstDclSig (mkNameSet binders)
318 bindLocalNames binders (renameSigs ok_sig uprags) `thenM` \ uprags' ->
320 returnM (InstDecl inst_ty' mbinds' uprags' ats',
321 meth_fvs `plusFV` at_fvs
322 `plusFV` hsSigsFVs uprags'
323 `plusFV` extractHsTyNames inst_ty')
324 -- We return the renamed associated data type declarations so
325 -- that they can be entered into the list of type declarations
326 -- for the binding group, but we also keep a copy in the instance.
327 -- The latter is needed for well-formedness checks in the type
328 -- checker (eg, to ensure that all ATs of the instance actually
329 -- receive a declaration).
330 -- NB: Even the copies in the instance declaration carry copies of
331 -- the instance context after renaming. This is a bit
332 -- strange, but should not matter (and it would be more work
333 -- to remove the context).
336 Renaming of the associated type definitions in instances.
338 * In the case of associated data and newtype definitions we add the instance
340 * We raise an error if we encounter a kind signature in an instance.
343 rnATDefs :: HsContext RdrName -> [LTyClDecl RdrName]
344 -> RnM ([LTyClDecl Name], FreeVars)
345 rnATDefs ctxt atDecls =
346 mapFvRn (wrapLocFstM rnAtDef) atDecls
348 rnAtDef tydecl@TyFunction {} =
352 rnAtDef tydecl@TySynonym {} = rnTyClDecl tydecl
353 rnAtDef tydecl@TyData {tcdCtxt = L l tyCtxt} =
355 checkM (not . isKindSigDecl $ tydecl) $ addErr noKindSig
356 rnTyClDecl (tydecl {tcdCtxt = L l (ctxt ++ tyCtxt)})
357 -- The source loc is somewhat half hearted... -=chak
359 panic "RnSource.rnATDefs: not a type declaration"
361 noKindSig = text "Instances cannot have kind signatures"
364 For the method bindings in class and instance decls, we extend the
365 type variable environment iff -fglasgow-exts
368 extendTyVarEnvForMethodBinds tyvars thing_inside
369 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
370 if opt_GlasgowExts then
371 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
377 %*********************************************************
381 %*********************************************************
384 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
385 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
387 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
388 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
390 rnLExpr lhs `thenM` \ (lhs', fv_lhs') ->
391 rnLExpr rhs `thenM` \ (rhs', fv_rhs') ->
393 checkValidRule rule_name ids lhs' fv_lhs' `thenM_`
395 returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
396 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
398 doc = text "In the transformation rule" <+> ftext rule_name
400 get_var (RuleBndr v) = v
401 get_var (RuleBndrSig v _) = v
403 rn_var (RuleBndr (L loc v), id)
404 = returnM (RuleBndr (L loc id), emptyFVs)
405 rn_var (RuleBndrSig (L loc v) t, id)
406 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
407 returnM (RuleBndrSig (L loc id) t', fvs)
410 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
411 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
412 ptext SLIT("does not appear on left hand side")]
415 Note [Rule LHS validity checking]
416 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
417 Check the shape of a transformation rule LHS. Currently we only allow
418 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
419 @forall@'d variables.
421 We used restrict the form of the 'ei' to prevent you writing rules
422 with LHSs with a complicated desugaring (and hence unlikely to match);
423 (e.g. a case expression is not allowed: too elaborate.)
425 But there are legitimate non-trivial args ei, like sections and
426 lambdas. So it seems simmpler not to check at all, and that is why
427 check_e is commented out.
430 checkValidRule rule_name ids lhs' fv_lhs'
431 = do { -- Check for the form of the LHS
432 case (validRuleLhs ids lhs') of
434 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
436 -- Check that LHS vars are all bound
437 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
438 ; mappM (addErr . badRuleVar rule_name) bad_vars }
440 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
442 -- Just e => Not ok, and e is the offending expression
443 validRuleLhs foralls lhs
446 checkl (L loc e) = check e
448 check (OpApp e1 op _ e2) = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
449 check (HsApp e1 e2) = checkl e1 `seqMaybe` checkl_e e2
450 check (HsVar v) | v `notElem` foralls = Nothing
451 check other = Just other -- Failure
454 checkl_e (L loc e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
456 {- Commented out; see Note [Rule LHS validity checking] above
457 check_e (HsVar v) = Nothing
458 check_e (HsPar e) = checkl_e e
459 check_e (HsLit e) = Nothing
460 check_e (HsOverLit e) = Nothing
462 check_e (OpApp e1 op _ e2) = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
463 check_e (HsApp e1 e2) = checkl_e e1 `seqMaybe` checkl_e e2
464 check_e (NegApp e _) = checkl_e e
465 check_e (ExplicitList _ es) = checkl_es es
466 check_e (ExplicitTuple es _) = checkl_es es
467 check_e other = Just other -- Fails
469 checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
472 badRuleLhsErr name lhs bad_e
473 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
474 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
475 ptext SLIT("in left-hand side:") <+> ppr lhs])]
477 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
481 %*********************************************************
483 \subsection{Type, class and iface sig declarations}
485 %*********************************************************
487 @rnTyDecl@ uses the `global name function' to create a new type
488 declaration in which local names have been replaced by their original
489 names, reporting any unknown names.
491 Renaming type variables is a pain. Because they now contain uniques,
492 it is necessary to pass in an association list which maps a parsed
493 tyvar to its @Name@ representation.
494 In some cases (type signatures of values),
495 it is even necessary to go over the type first
496 in order to get the set of tyvars used by it, make an assoc list,
497 and then go over it again to rename the tyvars!
498 However, we can also do some scoping checks at the same time.
501 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
502 = lookupLocatedTopBndrRn name `thenM` \ name' ->
503 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
506 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
507 tcdLName = tycon, tcdTyVars = tyvars,
508 tcdTyPats = typatsMaybe, tcdCons = condecls,
509 tcdKindSig = sig, tcdDerivs = derivs})
510 | isKindSigDecl tydecl -- kind signature of indexed type
511 = rnTySig tydecl bindTyVarsRn
512 | is_vanilla -- Normal Haskell data type decl
513 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
514 -- data type is syntactically illegal
515 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
516 do { tycon' <- lookupLocatedTopBndrRn tycon
517 ; context' <- rnContext data_doc context
518 ; typats' <- rnTyPats data_doc typatsMaybe
519 ; (derivs', deriv_fvs) <- rn_derivs derivs
520 ; checkDupNames data_doc con_names
521 ; condecls' <- rnConDecls (unLoc tycon') condecls
522 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
523 tcdLName = tycon', tcdTyVars = tyvars',
524 tcdTyPats = typats', tcdKindSig = Nothing,
525 tcdCons = condecls', tcdDerivs = derivs'},
526 delFVs (map hsLTyVarName tyvars') $
527 extractHsCtxtTyNames context' `plusFV`
528 plusFVs (map conDeclFVs condecls') `plusFV`
532 = ASSERT( none typatsMaybe ) -- GADTs cannot have type patterns for now
533 do { tycon' <- 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` deriv_fvs) }
550 is_vanilla = case condecls of -- Yuk
552 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
556 none (Just []) = True
559 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
560 con_names = map con_names_helper condecls
562 con_names_helper (L _ c) = con_name c
564 rn_derivs Nothing = returnM (Nothing, emptyFVs)
565 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
566 returnM (Just ds', extractHsTyNames_s ds')
568 rnTyClDecl (tydecl@TyFunction {}) =
569 rnTySig tydecl bindTyVarsRn
571 rnTyClDecl (TySynonym {tcdLName = name, tcdTyVars = tyvars,
572 tcdTyPats = typatsMaybe, tcdSynRhs = ty})
573 = bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
574 do { name' <- lookupLocatedTopBndrRn name
575 ; typats' <- rnTyPats syn_doc typatsMaybe
576 ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
577 ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
578 tcdTyPats = typats', tcdSynRhs = ty'},
579 delFVs (map hsLTyVarName tyvars') fvs) }
581 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
583 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
584 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
585 tcdMeths = mbinds, tcdATs = ats})
586 = lookupLocatedTopBndrRn cname `thenM` \ cname' ->
588 -- Tyvars scope over superclass context and method signatures
589 bindTyVarsRn cls_doc tyvars ( \ tyvars' ->
590 rnContext cls_doc context `thenM` \ context' ->
591 rnFds cls_doc fds `thenM` \ fds' ->
592 rnATs ats `thenM` \ (ats', ats_fvs) ->
593 renameSigs okClsDclSig sigs `thenM` \ sigs' ->
594 returnM (tyvars', context', fds', (ats', ats_fvs), sigs')
595 ) `thenM` \ (tyvars', context', fds', (ats', ats_fvs), sigs') ->
597 -- Check for duplicates among the associated types
599 at_rdr_names_w_locs = [tcdLName ty | L _ ty <- ats]
601 checkDupNames at_doc at_rdr_names_w_locs `thenM_`
603 -- Check the signatures
604 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
606 sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
608 checkDupNames sig_doc sig_rdr_names_w_locs `thenM_`
609 -- Typechecker is responsible for checking that we only
610 -- give default-method bindings for things in this class.
611 -- The renamer *could* check this for class decls, but can't
612 -- for instance decls.
614 -- The newLocals call is tiresome: given a generic class decl
617 -- op {| x+y |} (Inl a) = ...
618 -- op {| x+y |} (Inr b) = ...
619 -- op {| a*b |} (a*b) = ...
620 -- we want to name both "x" tyvars with the same unique, so that they are
621 -- easy to group together in the typechecker.
622 extendTyVarEnvForMethodBinds tyvars' (
623 getLocalRdrEnv `thenM` \ name_env ->
625 meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
626 gen_rdr_tyvars_w_locs =
627 [ tv | tv <- extractGenericPatTyVars mbinds,
628 not (unLoc tv `elemLocalRdrEnv` name_env) ]
630 checkDupNames meth_doc meth_rdr_names_w_locs `thenM_`
631 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
632 rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds
633 ) `thenM` \ (mbinds', meth_fvs) ->
635 returnM (ClassDecl { tcdCtxt = context', tcdLName = cname',
636 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
637 tcdMeths = mbinds', tcdATs = ats'},
638 delFVs (map hsLTyVarName tyvars') $
639 extractHsCtxtTyNames context' `plusFV`
640 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
641 hsSigsFVs sigs' `plusFV`
645 meth_doc = text "In the default-methods for class" <+> ppr cname
646 cls_doc = text "In the declaration for class" <+> ppr cname
647 sig_doc = text "In the signatures for class" <+> ppr cname
648 at_doc = text "In the associated types for class" <+> ppr cname
650 badGadtStupidTheta tycon
651 = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
652 ptext SLIT("(You can put a context on each contructor, though.)")]
655 %*********************************************************
657 \subsection{Support code for type/data declarations}
659 %*********************************************************
662 -- Although, we are processing type patterns here, all type variables will
663 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
664 -- type declaration to which these patterns belong)
666 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
667 rnTyPats _ Nothing = return Nothing
668 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
670 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
671 rnConDecls tycon condecls
672 = mappM (wrapLocM rnConDecl) condecls
674 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
675 rnConDecl (ConDecl name expl tvs cxt details res_ty)
676 = do { addLocM checkConName name
678 ; new_name <- lookupLocatedTopBndrRn name
679 ; name_env <- getLocalRdrEnv
681 -- For H98 syntax, the tvs are the existential ones
682 -- For GADT syntax, the tvs are all the quantified tyvars
683 -- Hence the 'filter' in the ResTyH98 case only
684 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
685 arg_tys = hsConArgs details
686 implicit_tvs = case res_ty of
687 ResTyH98 -> filter not_in_scope $
689 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
692 Implicit -> userHsTyVarBndrs implicit_tvs
694 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
695 { new_context <- rnContext doc cxt
696 ; new_details <- rnConDetails doc details
697 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
698 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty) }}
700 doc = text "In the definition of data constructor" <+> quotes (ppr name)
701 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
703 rnConResult _ details ResTyH98 = return (details, ResTyH98)
705 rnConResult doc details (ResTyGADT ty) = do
706 ty' <- rnHsSigType doc ty
707 let (arg_tys, res_ty) = splitHsFunType ty'
708 -- We can split it up, now the renamer has dealt with fixities
710 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
711 RecCon fields -> return (details, ResTyGADT ty')
712 InfixCon {} -> panic "rnConResult"
714 rnConDetails doc (PrefixCon tys)
715 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
716 returnM (PrefixCon new_tys)
718 rnConDetails doc (InfixCon ty1 ty2)
719 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
720 rnLHsType doc ty2 `thenM` \ new_ty2 ->
721 returnM (InfixCon new_ty1 new_ty2)
723 rnConDetails doc (RecCon fields)
724 = checkDupNames doc field_names `thenM_`
725 mappM (rnField doc) fields `thenM` \ new_fields ->
726 returnM (RecCon new_fields)
728 field_names = [fld | (fld, _) <- fields]
730 rnField doc (name, ty)
731 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
732 rnLHsType doc ty `thenM` \ new_ty ->
733 returnM (new_name, new_ty)
735 -- Rename kind signatures (signatures of indexed data types/newtypes and
736 -- signatures of type functions)
738 -- * This function is parametrised by the routine handling the index
739 -- variables. On the toplevel, these are defining occurences, whereas they
740 -- are usage occurences for associated types.
742 rnTySig :: TyClDecl RdrName
743 -> (SDoc -> [LHsTyVarBndr RdrName] ->
744 ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
745 RnM (TyClDecl Name, FreeVars))
746 -> RnM (TyClDecl Name, FreeVars)
748 rnTySig (tydecl@TyData {tcdCtxt = context, tcdLName = tycon,
749 tcdTyVars = tyvars, tcdTyPats = mb_typats,
750 tcdCons = condecls, tcdKindSig = sig,
753 ASSERT( null condecls ) -- won't have constructors
754 ASSERT( isNothing mb_typats ) -- won't have type patterns
755 ASSERT( isNothing derivs ) -- won't have deriving
756 ASSERT( isJust sig ) -- will have kind signature
757 do { checkM (not . null $ tyvars) $ addErr needOneIdx -- #indexes >= 1
758 ; bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
759 ; tycon' <- lookupLocatedTopBndrRn tycon
760 ; context' <- rnContext (ksig_doc tycon) context
761 ; returnM (TyData {tcdND = tcdND tydecl, tcdCtxt = context',
762 tcdLName = tycon', tcdTyVars = tyvars',
763 tcdTyPats = Nothing, tcdKindSig = sig,
764 tcdCons = [], tcdDerivs = Nothing},
765 delFVs (map hsLTyVarName tyvars') $
766 extractHsCtxtTyNames context') } }
769 rnTySig (tydecl@TyFunction {tcdLName = tycon, tcdTyVars = tyvars,
772 do { checkM (not . null $ tyvars) $ addErr needOneIdx -- #indexes >= 1
773 ; bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
774 ; tycon' <- lookupLocatedTopBndrRn tycon
775 ; returnM (TyFunction {tcdLName = tycon', tcdTyVars = tyvars',
776 tcdIso = tcdIso tydecl, tcdKind = sig},
779 ksig_doc tycon = text "In the kind signature for" <+> quotes (ppr tycon)
780 needOneIdx = text "Kind signature requires at least one type index"
782 -- Rename associated type declarations (in classes)
784 -- * This can be kind signatures and (default) type function equations.
786 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
787 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
789 rn_at (tydecl@TyData {}) = rnTySig tydecl lookupIdxVars
790 rn_at (tydecl@TyFunction {}) = rnTySig tydecl lookupIdxVars
791 rn_at (tydecl@TySynonym {}) =
793 checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
795 rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
797 lookupIdxVars _ tyvars cont = mappM lookupIdxVar tyvars >>= cont
799 -- Type index variables must be class parameters, which are the only
800 -- type variables in scope at this point.
801 lookupIdxVar (L l tyvar) =
803 name' <- lookupOccRn (hsTyVarName tyvar)
804 return $ L l (replaceTyVarName tyvar name')
806 noPatterns = text "Default definition for an associated synonym cannot have"
807 <+> text "type pattern"
809 -- This data decl will parse OK
811 -- treating "a" as the constructor.
812 -- It is really hard to make the parser spot this malformation.
813 -- So the renamer has to check that the constructor is legal
815 -- We can get an operator as the constructor, even in the prefix form:
816 -- data T = :% Int Int
817 -- from interface files, which always print in prefix form
819 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
822 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
826 %*********************************************************
828 \subsection{Support code to rename types}
830 %*********************************************************
833 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
836 = mappM (wrapLocM rn_fds) fds
839 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
840 rnHsTyVars doc tys2 `thenM` \ tys2' ->
841 returnM (tys1', tys2')
843 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
844 rnHsTyvar doc tyvar = lookupOccRn tyvar
848 %*********************************************************
852 %*********************************************************
858 h = ...$(thing "f")...
860 The splice can expand into literally anything, so when we do dependency
861 analysis we must assume that it might mention 'f'. So we simply treat
862 all locally-defined names as mentioned by any splice. This is terribly
863 brutal, but I don't see what else to do. For example, it'll mean
864 that every locally-defined thing will appear to be used, so no unused-binding
865 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
866 and that will crash the type checker because 'f' isn't in scope.
868 Currently, I'm not treating a splice as also mentioning every import,
869 which is a bit inconsistent -- but there are a lot of them. We might
870 thereby get some bogus unused-import warnings, but we won't crash the
871 type checker. Not very satisfactory really.
874 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
875 rnSplice (HsSplice n expr)
876 = do { checkTH expr "splice"
878 ; [n'] <- newLocalsRn [L loc n]
879 ; (expr', fvs) <- rnLExpr expr
881 -- Ugh! See Note [Splices] above
882 ; lcl_rdr <- getLocalRdrEnv
883 ; gbl_rdr <- getGlobalRdrEnv
884 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
886 lcl_names = mkNameSet (occEnvElts lcl_rdr)
888 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
891 checkTH e what = returnM () -- OK
893 checkTH e what -- Raise an error in a stage-1 compiler
894 = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
895 ptext SLIT("illegal in a stage-1 compiler"),