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, 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 )
45 import Monad ( liftM )
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 ;
114 [ats | L _ (InstDecl _ _ _ ats) <- rn_inst_decls] ;
115 rn_group = HsGroup { hs_valds = rn_val_decls,
116 hs_tyclds = rn_tycl_decls ++ rn_at_decls,
117 hs_instds = rn_inst_decls,
118 hs_fixds = rn_fix_decls,
120 hs_fords = rn_foreign_decls,
121 hs_defds = rn_default_decls,
122 hs_ruleds = rn_rule_decls } ;
124 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3,
125 src_fvs4, src_fvs5] ;
126 src_dus = bind_dus `plusDU` usesOnly other_fvs
127 -- Note: src_dus will contain *uses* for locally-defined types
128 -- and classes, but no *defs* for them. (Because rnTyClDecl
129 -- returns only the uses.) This is a little
130 -- surprising but it doesn't actually matter at all.
133 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
134 traceRn (text "finish Dus" <+> ppr src_dus ) ;
135 tcg_env <- getGblEnv ;
136 return (tcg_env `addTcgDUs` src_dus, rn_group)
139 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
140 rnTyClDecls tycl_decls = do
141 (decls', fvs) <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls
144 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
145 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
149 %*********************************************************
151 Source-code fixity declarations
153 %*********************************************************
156 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
157 rnSrcFixityDecls fix_decls
158 = do fix_decls <- mapM rnFixityDecl fix_decls
159 return (concat fix_decls)
161 rnFixityDecl :: LFixitySig RdrName -> RnM [LFixitySig Name]
162 rnFixityDecl (L loc (FixitySig (L nameLoc rdr_name) fixity))
163 = setSrcSpan nameLoc $
164 -- GHC extension: look up both the tycon and data con
165 -- for con-like things
166 -- If neither are in scope, report an error; otherwise
167 -- add both to the fixity env
168 do names <- lookupLocalDataTcNames rdr_name
169 return [ L loc (FixitySig (L nameLoc name) fixity)
172 rnSrcFixityDeclsEnv :: [LFixitySig Name] -> RnM FixityEnv
173 rnSrcFixityDeclsEnv fix_decls
174 = getGblEnv `thenM` \ gbl_env ->
175 foldlM rnFixityDeclEnv (tcg_fix_env gbl_env)
176 fix_decls `thenM` \ fix_env ->
177 traceRn (text "fixity env" <+> pprFixEnv fix_env) `thenM_`
180 rnFixityDeclEnv :: FixityEnv -> LFixitySig Name -> RnM FixityEnv
181 rnFixityDeclEnv fix_env (L loc (FixitySig (L nameLoc name) fixity))
182 = case lookupNameEnv fix_env name of
183 Just (FixItem _ _ loc')
184 -> do addLocErr (L nameLoc name) (dupFixityDecl loc')
187 -> return (extendNameEnv fix_env name fix_item)
188 where fix_item = FixItem (nameOccName name) fixity nameLoc
190 pprFixEnv :: FixityEnv -> SDoc
192 = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
195 dupFixityDecl loc rdr_name
196 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
197 ptext SLIT("also at ") <+> ppr loc
202 %*********************************************************
204 Source-code deprecations declarations
206 %*********************************************************
208 For deprecations, all we do is check that the names are in scope.
209 It's only imported deprecations, dealt with in RnIfaces, that we
210 gather them together.
213 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
217 rnSrcDeprecDecls decls
218 = mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
219 returnM (DeprecSome (mkNameEnv (concat pairs_s)))
221 rn_deprec (Deprecation rdr_name txt)
222 = lookupLocalDataTcNames rdr_name `thenM` \ names ->
223 returnM [(name, (nameOccName name, txt)) | name <- names]
225 checkModDeprec :: Maybe DeprecTxt -> Deprecations
226 -- Check for a module deprecation; done once at top level
227 checkModDeprec Nothing = NoDeprecs
228 checkModDeprec (Just txt) = DeprecAll txt
231 %*********************************************************
233 \subsection{Source code declarations}
235 %*********************************************************
238 rnDefaultDecl (DefaultDecl tys)
239 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
240 returnM (DefaultDecl tys', fvs)
242 doc_str = text "In a `default' declaration"
245 %*********************************************************
247 \subsection{Foreign declarations}
249 %*********************************************************
252 rnHsForeignDecl (ForeignImport name ty spec)
253 = lookupLocatedTopBndrRn name `thenM` \ name' ->
254 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
255 returnM (ForeignImport name' ty' spec, fvs)
257 rnHsForeignDecl (ForeignExport name ty spec)
258 = lookupLocatedOccRn name `thenM` \ name' ->
259 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
260 returnM (ForeignExport name' ty' spec, fvs )
261 -- NB: a foreign export is an *occurrence site* for name, so
262 -- we add it to the free-variable list. It might, for example,
263 -- be imported from another module
265 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
269 %*********************************************************
271 \subsection{Instance declarations}
273 %*********************************************************
276 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
277 -- Used for both source and interface file decls
278 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
280 -- Rename the associated types
281 -- The typechecker (not the renamer) checks that all
282 -- the declarations are for the right class
284 at_doc = text "In the associated types in an instance declaration"
285 at_names = map (head . tyClDeclNames . unLoc) ats
286 (_, rdrCtxt, _, _) = splitHsInstDeclTy (unLoc inst_ty)
288 checkDupNames at_doc at_names `thenM_`
289 rnATDefs rdrCtxt ats `thenM` \ (ats', at_fvs) ->
291 -- Rename the bindings
292 -- The typechecker (not the renamer) checks that all
293 -- the bindings are for the right class
295 meth_doc = text "In the bindings in an instance declaration"
296 meth_names = collectHsBindLocatedBinders mbinds
297 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
299 checkDupNames meth_doc meth_names `thenM_`
300 extendTyVarEnvForMethodBinds inst_tyvars (
301 -- (Slightly strangely) the forall-d tyvars scope over
302 -- the method bindings too
303 rnMethodBinds cls (\n->[]) -- No scoped tyvars
305 ) `thenM` \ (mbinds', meth_fvs) ->
306 -- Rename the prags and signatures.
307 -- Note that the type variables are not in scope here,
308 -- so that instance Eq a => Eq (T a) where
309 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
312 -- But the (unqualified) method names are in scope
314 binders = collectHsBindBinders mbinds'
315 ok_sig = okInstDclSig (mkNameSet binders)
317 bindLocalNames binders (renameSigs ok_sig uprags) `thenM` \ uprags' ->
319 returnM (InstDecl inst_ty' mbinds' uprags' ats',
320 meth_fvs `plusFV` at_fvs
321 `plusFV` hsSigsFVs uprags'
322 `plusFV` extractHsTyNames inst_ty')
323 -- We return the renamed associated data type declarations so
324 -- that they can be entered into the list of type declarations
325 -- for the binding group, but we also keep a copy in the instance.
326 -- The latter is needed for well-formedness checks in the type
327 -- checker (eg, to ensure that all ATs of the instance actually
328 -- receive a declaration).
329 -- NB: Even the copies in the instance declaration carry copies of
330 -- the instance context after renaming. This is a bit
331 -- strange, but should not matter (and it would be more work
332 -- to remove the context).
335 Renaming of the associated data definitions requires adding the instance
336 context, as the rhs of an AT declaration may use ATs from classes in the
340 rnATDefs :: HsContext RdrName -> [LTyClDecl RdrName]
341 -> RnM ([LTyClDecl Name], FreeVars)
342 rnATDefs ctxt atDecls =
343 mapFvRn (wrapLocFstM addCtxtAndRename) atDecls
345 -- The parser won't accept anything, but a data declaration
346 addCtxtAndRename ty@TyData {tcdCtxt = L l tyCtxt} =
347 rnTyClDecl (ty {tcdCtxt = L l (ctxt ++ tyCtxt)})
348 -- The source loc is somewhat half hearted... -=chak
351 For the method bindings in class and instance decls, we extend the
352 type variable environment iff -fglasgow-exts
355 extendTyVarEnvForMethodBinds tyvars thing_inside
356 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
357 if opt_GlasgowExts then
358 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
364 %*********************************************************
368 %*********************************************************
371 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
372 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
374 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
375 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
377 rnLExpr lhs `thenM` \ (lhs', fv_lhs') ->
378 rnLExpr rhs `thenM` \ (rhs', fv_rhs') ->
380 checkValidRule rule_name ids lhs' fv_lhs' `thenM_`
382 returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
383 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
385 doc = text "In the transformation rule" <+> ftext rule_name
387 get_var (RuleBndr v) = v
388 get_var (RuleBndrSig v _) = v
390 rn_var (RuleBndr (L loc v), id)
391 = returnM (RuleBndr (L loc id), emptyFVs)
392 rn_var (RuleBndrSig (L loc v) t, id)
393 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
394 returnM (RuleBndrSig (L loc id) t', fvs)
397 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
398 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
399 ptext SLIT("does not appear on left hand side")]
402 Note [Rule LHS validity checking]
403 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
404 Check the shape of a transformation rule LHS. Currently we only allow
405 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
406 @forall@'d variables.
408 We used restrict the form of the 'ei' to prevent you writing rules
409 with LHSs with a complicated desugaring (and hence unlikely to match);
410 (e.g. a case expression is not allowed: too elaborate.)
412 But there are legitimate non-trivial args ei, like sections and
413 lambdas. So it seems simmpler not to check at all, and that is why
414 check_e is commented out.
417 checkValidRule rule_name ids lhs' fv_lhs'
418 = do { -- Check for the form of the LHS
419 case (validRuleLhs ids lhs') of
421 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
423 -- Check that LHS vars are all bound
424 ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
425 ; mappM (addErr . badRuleVar rule_name) bad_vars }
427 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
429 -- Just e => Not ok, and e is the offending expression
430 validRuleLhs foralls lhs
433 checkl (L loc e) = check e
435 check (OpApp e1 op _ e2) = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
436 check (HsApp e1 e2) = checkl e1 `seqMaybe` checkl_e e2
437 check (HsVar v) | v `notElem` foralls = Nothing
438 check other = Just other -- Failure
441 checkl_e (L loc e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
443 {- Commented out; see Note [Rule LHS validity checking] above
444 check_e (HsVar v) = Nothing
445 check_e (HsPar e) = checkl_e e
446 check_e (HsLit e) = Nothing
447 check_e (HsOverLit e) = Nothing
449 check_e (OpApp e1 op _ e2) = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
450 check_e (HsApp e1 e2) = checkl_e e1 `seqMaybe` checkl_e e2
451 check_e (NegApp e _) = checkl_e e
452 check_e (ExplicitList _ es) = checkl_es es
453 check_e (ExplicitTuple es _) = checkl_es es
454 check_e other = Just other -- Fails
456 checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
459 badRuleLhsErr name lhs bad_e
460 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
461 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
462 ptext SLIT("in left-hand side:") <+> ppr lhs])]
464 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
468 %*********************************************************
470 \subsection{Type, class and iface sig declarations}
472 %*********************************************************
474 @rnTyDecl@ uses the `global name function' to create a new type
475 declaration in which local names have been replaced by their original
476 names, reporting any unknown names.
478 Renaming type variables is a pain. Because they now contain uniques,
479 it is necessary to pass in an association list which maps a parsed
480 tyvar to its @Name@ representation.
481 In some cases (type signatures of values),
482 it is even necessary to go over the type first
483 in order to get the set of tyvars used by it, make an assoc list,
484 and then go over it again to rename the tyvars!
485 However, we can also do some scoping checks at the same time.
488 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
489 = lookupLocatedTopBndrRn name `thenM` \ name' ->
490 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
493 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = tycon,
494 tcdTyVars = tyvars, tcdTyPats = typatsMaybe,
495 tcdCons = condecls, tcdKindSig = sig, tcdDerivs = derivs})
496 | is_vanilla -- Normal Haskell data type decl
497 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
498 -- data type is syntactically illegal
499 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
500 do { tycon' <- lookupLocatedTopBndrRn tycon
501 ; context' <- rnContext data_doc context
502 ; typats' <- rnTyPats data_doc typatsMaybe
503 ; (derivs', deriv_fvs) <- rn_derivs derivs
504 ; checkDupNames data_doc con_names
505 ; condecls' <- rnConDecls (unLoc tycon') condecls
506 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
507 tcdLName = tycon', tcdTyVars = tyvars',
508 tcdTyPats = typats', tcdKindSig = Nothing,
509 tcdCons = condecls', tcdDerivs = derivs'},
510 delFVs (map hsLTyVarName tyvars') $
511 extractHsCtxtTyNames context' `plusFV`
512 plusFVs (map conDeclFVs condecls') `plusFV`
516 = ASSERT( null typats ) -- GADTs cannot have type patterns for now
517 do { tycon' <- lookupLocatedTopBndrRn tycon
518 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
519 ; tyvars' <- bindTyVarsRn data_doc tyvars
520 (\ tyvars' -> return tyvars')
521 -- For GADTs, the type variables in the declaration
522 -- do not scope over the constructor signatures
523 -- data T a where { T1 :: forall b. b-> b }
524 ; (derivs', deriv_fvs) <- rn_derivs derivs
525 ; checkDupNames data_doc con_names
526 ; condecls' <- rnConDecls (unLoc tycon') condecls
527 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
528 tcdLName = tycon', tcdTyVars = tyvars',
529 tcdTyPats = Nothing, tcdKindSig = sig,
530 tcdCons = condecls', tcdDerivs = derivs'},
531 plusFVs (map conDeclFVs condecls') `plusFV` deriv_fvs) }
534 is_vanilla = case condecls of -- Yuk
536 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
539 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
540 con_names = map con_names_helper condecls
542 con_names_helper (L _ c) = con_name c
544 rn_derivs Nothing = returnM (Nothing, emptyFVs)
545 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
546 returnM (Just ds', extractHsTyNames_s ds')
548 rnTyClDecl (TySynonym {tcdLName = name, tcdTyVars = tyvars, tcdSynRhs = ty})
549 = lookupLocatedTopBndrRn name `thenM` \ name' ->
550 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
551 rnHsTypeFVs syn_doc ty `thenM` \ (ty', fvs) ->
552 returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
554 delFVs (map hsLTyVarName tyvars') fvs)
556 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
558 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
559 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
560 tcdMeths = mbinds, tcdATs = ats})
561 = lookupLocatedTopBndrRn cname `thenM` \ cname' ->
563 -- Tyvars scope over superclass context and method signatures
564 bindTyVarsRn cls_doc tyvars ( \ tyvars' ->
565 rnContext cls_doc context `thenM` \ context' ->
566 rnFds cls_doc fds `thenM` \ fds' ->
567 rnATs tyvars' ats `thenM` \ (ats', ats_fvs) ->
568 renameSigs okClsDclSig sigs `thenM` \ sigs' ->
569 returnM (tyvars', context', fds', (ats', ats_fvs), sigs')
570 ) `thenM` \ (tyvars', context', fds', (ats', ats_fvs), sigs') ->
572 -- Check for duplicates among the associated types
574 at_rdr_names_w_locs = [tcdLName ty | L _ ty <- ats]
576 checkDupNames at_doc at_rdr_names_w_locs `thenM_`
578 -- Check the signatures
579 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
581 sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
583 checkDupNames sig_doc sig_rdr_names_w_locs `thenM_`
584 -- Typechecker is responsible for checking that we only
585 -- give default-method bindings for things in this class.
586 -- The renamer *could* check this for class decls, but can't
587 -- for instance decls.
589 -- The newLocals call is tiresome: given a generic class decl
592 -- op {| x+y |} (Inl a) = ...
593 -- op {| x+y |} (Inr b) = ...
594 -- op {| a*b |} (a*b) = ...
595 -- we want to name both "x" tyvars with the same unique, so that they are
596 -- easy to group together in the typechecker.
597 extendTyVarEnvForMethodBinds tyvars' (
598 getLocalRdrEnv `thenM` \ name_env ->
600 meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
601 gen_rdr_tyvars_w_locs =
602 [ tv | tv <- extractGenericPatTyVars mbinds,
603 not (unLoc tv `elemLocalRdrEnv` name_env) ]
605 checkDupNames meth_doc meth_rdr_names_w_locs `thenM_`
606 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
607 rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds
608 ) `thenM` \ (mbinds', meth_fvs) ->
610 returnM (ClassDecl { tcdCtxt = context', tcdLName = cname',
611 tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
612 tcdMeths = mbinds', tcdATs = ats'},
613 delFVs (map hsLTyVarName tyvars') $
614 extractHsCtxtTyNames context' `plusFV`
615 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
616 hsSigsFVs sigs' `plusFV`
620 meth_doc = text "In the default-methods for class" <+> ppr cname
621 cls_doc = text "In the declaration for class" <+> ppr cname
622 sig_doc = text "In the signatures for class" <+> ppr cname
623 at_doc = text "In the associated types for class" <+> ppr cname
625 badGadtStupidTheta tycon
626 = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
627 ptext SLIT("(You can put a context on each contructor, though.)")]
630 %*********************************************************
632 \subsection{Support code for type/data declarations}
634 %*********************************************************
637 -- Although, we are processing type patterns here, all type variables should
638 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
639 -- type declaration to which these patterns belong)
641 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
642 rnTyPats _ Nothing = return Nothing
643 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
645 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
646 rnConDecls tycon condecls
647 = mappM (wrapLocM rnConDecl) condecls
649 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
650 rnConDecl (ConDecl name expl tvs cxt details res_ty)
651 = do { addLocM checkConName name
653 ; new_name <- lookupLocatedTopBndrRn name
654 ; name_env <- getLocalRdrEnv
656 -- For H98 syntax, the tvs are the existential ones
657 -- For GADT syntax, the tvs are all the quantified tyvars
658 -- Hence the 'filter' in the ResTyH98 case only
659 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
660 arg_tys = hsConArgs details
661 implicit_tvs = case res_ty of
662 ResTyH98 -> filter not_in_scope $
664 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
667 Implicit -> userHsTyVarBndrs implicit_tvs
669 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
670 { new_context <- rnContext doc cxt
671 ; new_details <- rnConDetails doc details
672 ; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
673 ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty) }}
675 doc = text "In the definition of data constructor" <+> quotes (ppr name)
676 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
678 rnConResult _ details ResTyH98 = return (details, ResTyH98)
680 rnConResult doc details (ResTyGADT ty) = do
681 ty' <- rnHsSigType doc ty
682 let (arg_tys, res_ty) = splitHsFunType ty'
683 -- We can split it up, now the renamer has dealt with fixities
685 PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
686 RecCon fields -> return (details, ResTyGADT ty')
687 InfixCon {} -> panic "rnConResult"
689 rnConDetails doc (PrefixCon tys)
690 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
691 returnM (PrefixCon new_tys)
693 rnConDetails doc (InfixCon ty1 ty2)
694 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
695 rnLHsType doc ty2 `thenM` \ new_ty2 ->
696 returnM (InfixCon new_ty1 new_ty2)
698 rnConDetails doc (RecCon fields)
699 = checkDupNames doc field_names `thenM_`
700 mappM (rnField doc) fields `thenM` \ new_fields ->
701 returnM (RecCon new_fields)
703 field_names = [fld | (fld, _) <- fields]
705 rnField doc (name, ty)
706 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
707 rnLHsType doc ty `thenM` \ new_ty ->
708 returnM (new_name, new_ty)
710 -- This data decl will parse OK
712 -- treating "a" as the constructor.
713 -- It is really hard to make the parser spot this malformation.
714 -- So the renamer has to check that the constructor is legal
716 -- We can get an operator as the constructor, even in the prefix form:
717 -- data T = :% Int Int
718 -- from interface files, which always print in prefix form
720 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
723 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
727 %*********************************************************
729 \subsection{Support code to rename types}
731 %*********************************************************
734 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
737 = mappM (wrapLocM rn_fds) fds
740 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
741 rnHsTyVars doc tys2 `thenM` \ tys2' ->
742 returnM (tys1', tys2')
744 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
745 rnHsTyvar doc tyvar = lookupOccRn tyvar
747 -- Rename associated data type declarations
749 rnATs :: [LHsTyVarBndr Name] -> [LTyClDecl RdrName]
750 -> RnM ([LTyClDecl Name], FreeVars)
751 rnATs classLTyVars ats
752 = mapFvRn (wrapLocFstM rn_at) ats
754 -- The parser won't accept anything, but a data declarations
755 rn_at (tydecl@TyData {tcdCtxt = L ctxtL ctxt, tcdLName = tycon,
756 tcdTyPats = Just typats, tcdCons = condecls,
757 tcdDerivs = derivs}) =
758 do { checkM (null ctxt ) $ addErr atNoCtxt -- no context
759 ; checkM (null condecls) $ addErr atNoCons -- no constructors
760 -- check and collect type parameters
761 ; let (idxParms, excessParms) = splitAt (length classLTyVars) typats
762 ; zipWithM_ cmpTyVar idxParms classLTyVars
763 ; excessTyVars <- liftM catMaybes $ mappM chkTyVar excessParms
764 -- bind excess parameters
765 ; bindTyVarsRn data_doc excessTyVars $ \ excessTyVars' -> do {
766 ; tycon' <- lookupLocatedTopBndrRn tycon
767 ; (derivs', deriv_fvs) <- rn_derivs derivs
768 ; returnM (TyData {tcdND = tcdND tydecl, tcdCtxt = L ctxtL [],
770 tcdTyVars = classLTyVars ++ excessTyVars',
771 tcdTyPats = Nothing, tcdKindSig = Nothing,
772 tcdCons = [], tcdDerivs = derivs'},
773 delFVs (map hsLTyVarName (classLTyVars ++ excessTyVars')) $
776 -- Check that the name space is correct!
777 cmpTyVar (L l ty@(HsTyVar tv)) classTV = -- just a type variable
778 checkM (rdrNameOcc tv == nameOccName classTVName) $
779 mustMatchErr l ty classTVName
781 classTVName = hsLTyVarName classTV
782 cmpTyVar (L l ty@(HsKindSig (L _ (HsTyVar tv)) k)) _ | isRdrTyVar tv =
783 noKindSigErr l tv -- additional kind sig not allowed at class parms
784 cmpTyVar (L l otherTy) _ =
785 tyVarExpectedErr l -- parameter must be a type variable
787 -- Check that the name space is correct!
788 chkTyVar (L l (HsKindSig (L _ (HsTyVar tv)) k))
789 | isRdrTyVar tv = return $ Just (L l (KindedTyVar tv k))
790 chkTyVar (L l (HsTyVar tv))
791 | isRdrTyVar tv = return $ Just (L l (UserTyVar tv))
792 chkTyVar (L l otherTy) = tyVarExpectedErr l >> return Nothing
793 -- drop parameter; we stop after renaming anyways
795 rn_derivs Nothing = returnM (Nothing, emptyFVs)
796 rn_derivs (Just ds) = do
797 ds' <- rnLHsTypes data_doc ds
798 returnM (Just ds', extractHsTyNames_s ds')
800 atNoCtxt = text "Associated data type declarations cannot have a context"
801 atNoCons = text "Associated data type declarations cannot have any constructors"
802 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
806 sep [ptext SLIT("No kind signature allowed at copies of class parameters:"),
809 mustMatchErr l ty classTV =
811 sep [ptext SLIT("Type variable"), quotes (ppr ty),
812 ptext SLIT("must match corresponding class parameter"),
813 quotes (ppr classTV)]
816 addErrAt l (ptext SLIT("Type found where type variable expected"))
820 %*********************************************************
824 %*********************************************************
830 h = ...$(thing "f")...
832 The splice can expand into literally anything, so when we do dependency
833 analysis we must assume that it might mention 'f'. So we simply treat
834 all locally-defined names as mentioned by any splice. This is terribly
835 brutal, but I don't see what else to do. For example, it'll mean
836 that every locally-defined thing will appear to be used, so no unused-binding
837 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
838 and that will crash the type checker because 'f' isn't in scope.
840 Currently, I'm not treating a splice as also mentioning every import,
841 which is a bit inconsistent -- but there are a lot of them. We might
842 thereby get some bogus unused-import warnings, but we won't crash the
843 type checker. Not very satisfactory really.
846 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
847 rnSplice (HsSplice n expr)
848 = do { checkTH expr "splice"
850 ; [n'] <- newLocalsRn [L loc n]
851 ; (expr', fvs) <- rnLExpr expr
853 -- Ugh! See Note [Splices] above
854 ; lcl_rdr <- getLocalRdrEnv
855 ; gbl_rdr <- getGlobalRdrEnv
856 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
858 lcl_names = mkNameSet (occEnvElts lcl_rdr)
860 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
863 checkTH e what = returnM () -- OK
865 checkTH e what -- Raise an error in a stage-1 compiler
866 = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
867 ptext SLIT("illegal in a stage-1 compiler"),