2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
8 rnSrcDecls, rnExtCoreDecls, checkModDeprec,
9 rnTyClDecl, rnIfaceRuleDecl, rnInstDecl,
13 #include "HsVersions.h"
17 import RdrName ( RdrName, isRdrDataCon, elemRdrEnv )
18 import RdrHsSyn ( RdrNameConDecl, RdrNameTyClDecl, RdrNameHsDecl,
19 RdrNameDeprecation, RdrNameFixitySig,
21 extractGenericPatTyVars
26 import RnNames ( importsFromLocalDecls )
27 import RnTypes ( rnHsType, rnHsSigType, rnHsTypeFVs, rnContext )
29 import RnBinds ( rnTopMonoBinds, rnMonoBinds, rnMethodBinds,
30 renameSigs, renameSigsFVs )
31 import RnEnv ( lookupTopBndrRn, lookupOccRn, lookupSysBndr,
32 newLocalsRn, lookupGlobalOccRn,
33 bindLocalsFVRn, bindPatSigTyVars,
34 bindTyVarsRn, extendTyVarEnvFVRn,
35 bindCoreLocalRn, bindCoreLocalsRn, bindLocalNames,
36 checkDupOrQualNames, checkDupNames, mapFvRn,
37 lookupTopSrcBndr_maybe, lookupTopSrcBndr,
38 dataTcOccs, unknownNameErr,
43 import BasicTypes ( FixitySig(..) )
44 import HscTypes ( ExternalPackageState(..), FixityEnv,
45 Deprecations(..), plusDeprecs )
46 import Module ( moduleEnvElts )
47 import Class ( FunDep, DefMeth (..) )
48 import TyCon ( DataConDetails(..), visibleDataCons )
52 import ErrUtils ( dumpIfSet )
53 import PrelNames ( newStablePtrName, bindIOName, returnIOName )
54 import List ( partition )
55 import Bag ( bagToList )
57 import SrcLoc ( SrcLoc )
58 import CmdLineOpts ( DynFlag(..) )
59 -- Warn of unused for-all'd tyvars
60 import Maybes ( maybeToBool, seqMaybe )
61 import Maybe ( maybe, catMaybes, isNothing )
64 @rnSourceDecl@ `renames' declarations.
65 It simultaneously performs dependency analysis and precedence parsing.
66 It also does the following error checks:
69 Checks that tyvars are used properly. This includes checking
70 for undefined tyvars, and tyvars in contexts that are ambiguous.
71 (Some of this checking has now been moved to module @TcMonoType@,
72 since we don't have functional dependency information at this point.)
74 Checks that all variable occurences are defined.
76 Checks the @(..)@ etc constraints in the export list.
81 rnSrcDecls :: [RdrNameHsDecl] -> RnM (TcGblEnv, [RenamedHsDecl], FreeVars)
84 = do { (rdr_env, imports) <- importsFromLocalDecls decls ;
85 updGblEnv (\gbl -> gbl { tcg_rdr_env = rdr_env `plusGlobalRdrEnv`
87 tcg_imports = imports `plusImportAvails`
91 -- Deal with deprecations (returns only the extra deprecations)
92 deprecs <- rnSrcDeprecDecls [d | DeprecD d <- decls] ;
93 updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
96 -- Deal with top-level fixity decls
97 -- (returns the total new fixity env)
98 fix_env <- rnSrcFixityDecls decls ;
99 updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
102 -- Rename remaining declarations
103 (rn_src_decls, src_fvs) <- rn_src_decls decls ;
105 tcg_env <- getGblEnv ;
106 return (tcg_env, rn_src_decls, src_fvs)
109 rnExtCoreDecls :: [RdrNameHsDecl] -> RnM ([RenamedHsDecl], FreeVars)
110 rnExtCoreDecls decls = rn_src_decls decls
112 rn_src_decls decls -- Declarartions get reversed, but no matter
113 = go emptyFVs [] decls
115 -- Fixity and deprecations have been dealt with already; ignore them
116 go fvs ds' [] = returnM (ds', fvs)
117 go fvs ds' (FixD _:ds) = go fvs ds' ds
118 go fvs ds' (DeprecD _:ds) = go fvs ds' ds
119 go fvs ds' (d:ds) = rnSrcDecl d `thenM` \(d', fvs') ->
120 go (fvs `plusFV` fvs') (d':ds') ds
124 %*********************************************************
126 Source-code fixity declarations
128 %*********************************************************
131 rnSrcFixityDecls :: [RdrNameHsDecl] -> TcRn m FixityEnv
132 rnSrcFixityDecls decls
133 = getGblEnv `thenM` \ gbl_env ->
134 foldlM rnFixityDecl (tcg_fix_env gbl_env)
135 fix_decls `thenM` \ fix_env ->
136 traceRn (text "fixity env" <+> ppr fix_env) `thenM_`
139 fix_decls = foldr get_fix_sigs [] decls
141 -- Get fixities from top level decls, and from class decl sigs too
142 get_fix_sigs (FixD fix) acc = fix:acc
143 get_fix_sigs (TyClD (ClassDecl { tcdSigs = sigs})) acc
144 = [sig | FixSig sig <- sigs] ++ acc
145 get_fix_sigs other_decl acc = acc
147 rnFixityDecl :: FixityEnv -> RdrNameFixitySig -> TcRn m FixityEnv
148 rnFixityDecl fix_env (FixitySig rdr_name fixity loc)
149 = -- GHC extension: look up both the tycon and data con
150 -- for con-like things
151 -- If neither are in scope, report an error; otherwise
152 -- add both to the fixity env
153 mappM lookupTopSrcBndr_maybe (dataTcOccs rdr_name) `thenM` \ maybe_ns ->
154 case catMaybes maybe_ns of
155 [] -> addSrcLoc loc $
156 addErr (unknownNameErr rdr_name) `thenM_`
158 ns -> foldlM add fix_env ns
161 = case lookupNameEnv fix_env name of
162 Just (FixitySig _ _ loc') -> addErr (dupFixityDecl rdr_name loc loc') `thenM_`
164 Nothing -> returnM (extendNameEnv fix_env name (FixitySig name fixity loc))
166 dupFixityDecl rdr_name loc1 loc2
167 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
168 ptext SLIT("at ") <+> ppr loc1,
169 ptext SLIT("and") <+> ppr loc2]
173 %*********************************************************
175 Source-code deprecations declarations
177 %*********************************************************
179 For deprecations, all we do is check that the names are in scope.
180 It's only imported deprecations, dealt with in RnIfaces, that we
181 gather them together.
184 rnSrcDeprecDecls :: [RdrNameDeprecation] -> TcRn m Deprecations
188 rnSrcDeprecDecls decls
189 = mappM rn_deprec decls `thenM` \ pairs ->
190 returnM (DeprecSome (mkNameEnv (catMaybes pairs)))
192 rn_deprec (Deprecation rdr_name txt loc)
194 lookupTopSrcBndr rdr_name `thenM` \ name ->
195 returnM (Just (name, (name,txt)))
197 checkModDeprec :: Maybe DeprecTxt -> Deprecations
198 -- Check for a module deprecation; done once at top level
199 checkModDeprec Nothing = NoDeprecs
200 checkModdeprec (Just txt) = DeprecAll txt
203 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
207 %*********************************************************
209 \subsection{Source code declarations}
211 %*********************************************************
214 rnSrcDecl :: RdrNameHsDecl -> RnM (RenamedHsDecl, FreeVars)
216 rnSrcDecl (ValD binds) = rnTopBinds binds `thenM` \ (new_binds, fvs) ->
217 returnM (ValD new_binds, fvs)
219 rnSrcDecl (TyClD tycl_decl)
220 = rnTyClDecl tycl_decl `thenM` \ new_decl ->
221 finishSourceTyClDecl tycl_decl new_decl `thenM` \ (new_decl', fvs) ->
222 returnM (TyClD new_decl', fvs `plusFV` tyClDeclFVs new_decl')
224 rnSrcDecl (InstD inst)
225 = rnInstDecl inst `thenM` \ new_inst ->
226 finishSourceInstDecl inst new_inst `thenM` \ (new_inst', fvs) ->
227 returnM (InstD new_inst', fvs `plusFV` instDeclFVs new_inst')
229 rnSrcDecl (RuleD rule)
230 = rnHsRuleDecl rule `thenM` \ (new_rule, fvs) ->
231 returnM (RuleD new_rule, fvs)
233 rnSrcDecl (ForD ford)
234 = rnHsForeignDecl ford `thenM` \ (new_ford, fvs) ->
235 returnM (ForD new_ford, fvs)
237 rnSrcDecl (DefD (DefaultDecl tys src_loc))
238 = addSrcLoc src_loc $
239 mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
240 returnM (DefD (DefaultDecl tys' src_loc), fvs)
242 doc_str = text "In a `default' declaration"
245 rnSrcDecl (CoreD (CoreDecl name ty rhs loc))
247 lookupTopBndrRn name `thenM` \ name' ->
248 rnHsTypeFVs doc_str ty `thenM` \ (ty', ty_fvs) ->
249 rnCoreExpr rhs `thenM` \ rhs' ->
250 returnM (CoreD (CoreDecl name' ty' rhs' loc),
251 ty_fvs `plusFV` ufExprFVs rhs')
253 doc_str = text "In the Core declaration for" <+> quotes (ppr name)
256 %*********************************************************
260 %*********************************************************
262 These chaps are here, rather than in TcBinds, so that there
263 is just one hi-boot file (for RnSource). rnSrcDecls is part
264 of the loop too, and it must be defined in this module.
267 rnTopBinds :: RdrNameHsBinds -> RnM (RenamedHsBinds, FreeVars)
268 rnTopBinds EmptyBinds = returnM (EmptyBinds, emptyFVs)
269 rnTopBinds (MonoBind bind sigs _) = rnTopMonoBinds bind sigs
270 -- The parser doesn't produce other forms
272 rnBinds :: RdrNameHsBinds
273 -> (RenamedHsBinds -> RnM (result, FreeVars))
274 -> RnM (result, FreeVars)
275 rnBinds EmptyBinds thing_inside = thing_inside EmptyBinds
276 rnBinds (MonoBind bind sigs _) thing_inside = rnMonoBinds bind sigs thing_inside
277 -- the parser doesn't produce other forms
281 %*********************************************************
283 \subsection{Foreign declarations}
285 %*********************************************************
288 rnHsForeignDecl (ForeignImport name ty spec isDeprec src_loc)
289 = addSrcLoc src_loc $
290 lookupTopBndrRn name `thenM` \ name' ->
291 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
292 returnM (ForeignImport name' ty' spec isDeprec src_loc,
293 fvs `plusFV` extras spec)
295 extras (CImport _ _ _ _ CWrapper) = mkFVs [newStablePtrName,
296 bindIOName, returnIOName]
299 rnHsForeignDecl (ForeignExport name ty spec isDeprec src_loc)
300 = addSrcLoc src_loc $
301 lookupOccRn name `thenM` \ name' ->
302 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
303 returnM (ForeignExport name' ty' spec isDeprec src_loc,
304 mkFVs [bindIOName, returnIOName] `plusFV` fvs)
306 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
310 %*********************************************************
312 \subsection{Instance declarations}
314 %*********************************************************
317 rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
318 -- Used for both source and interface file decls
319 = addSrcLoc src_loc $
320 rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
322 (case maybe_dfun_rdr_name of
323 Nothing -> returnM Nothing
324 Just dfun_rdr_name -> lookupGlobalOccRn dfun_rdr_name `thenM` \ dfun_name ->
325 returnM (Just dfun_name)
326 ) `thenM` \ maybe_dfun_name ->
328 -- The typechecker checks that all the bindings are for the right class.
329 returnM (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
331 -- Compare finishSourceTyClDecl
332 finishSourceInstDecl (InstDecl _ mbinds uprags _ _ )
333 (InstDecl inst_ty _ _ maybe_dfun_name src_loc)
334 -- Used for both source decls only
335 = ASSERT( not (maybeToBool maybe_dfun_name) ) -- Source decl!
337 meth_doc = text "In the bindings in an instance declaration"
338 meth_names = collectLocatedMonoBinders mbinds
339 (inst_tyvars, _, cls,_) = splitHsInstDeclTy inst_ty
340 -- (Slightly strangely) the forall-d tyvars scope over
341 -- the method bindings too
344 -- Rename the bindings
345 -- NB meth_names can be qualified!
346 checkDupNames meth_doc meth_names `thenM_`
347 extendTyVarEnvForMethodBinds inst_tyvars (
348 rnMethodBinds cls [] mbinds
349 ) `thenM` \ (mbinds', meth_fvs) ->
351 binders = collectMonoBinders mbinds'
352 binder_set = mkNameSet binders
354 -- Rename the prags and signatures.
355 -- Note that the type variables are not in scope here,
356 -- so that instance Eq a => Eq (T a) where
357 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
360 -- But the (unqualified) method names are in scope
361 bindLocalNames binders (
362 renameSigsFVs (okInstDclSig binder_set) uprags
363 ) `thenM` \ (uprags', prag_fvs) ->
365 returnM (InstDecl inst_ty mbinds' uprags' maybe_dfun_name src_loc,
366 meth_fvs `plusFV` prag_fvs)
369 %*********************************************************
373 %*********************************************************
376 rnIfaceRuleDecl (IfaceRule rule_name act vars fn args rhs src_loc)
377 = addSrcLoc src_loc $
378 lookupOccRn fn `thenM` \ fn' ->
379 rnCoreBndrs vars $ \ vars' ->
380 mappM rnCoreExpr args `thenM` \ args' ->
381 rnCoreExpr rhs `thenM` \ rhs' ->
382 returnM (IfaceRule rule_name act vars' fn' args' rhs' src_loc)
384 rnIfaceRuleDecl (IfaceRuleOut fn rule) -- Builtin rules come this way
385 = lookupOccRn fn `thenM` \ fn' ->
386 returnM (IfaceRuleOut fn' rule)
388 rnHsRuleDecl (HsRule rule_name act vars lhs rhs src_loc)
389 = addSrcLoc src_loc $
390 bindPatSigTyVars (collectRuleBndrSigTys vars) $
392 bindLocalsFVRn doc (map get_var vars) $ \ ids ->
393 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
395 rnExpr lhs `thenM` \ (lhs', fv_lhs) ->
396 rnExpr rhs `thenM` \ (rhs', fv_rhs) ->
398 mb_bad = validRuleLhs ids lhs'
400 checkErr (isNothing mb_bad)
401 (badRuleLhsErr rule_name lhs' mb_bad) `thenM_`
403 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
405 mappM (addErr . badRuleVar rule_name) bad_vars `thenM_`
406 returnM (HsRule rule_name act vars' lhs' rhs' src_loc,
407 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
409 doc = text "In the transformation rule" <+> ftext rule_name
411 get_var (RuleBndr v) = v
412 get_var (RuleBndrSig v _) = v
414 rn_var (RuleBndr v, id) = returnM (RuleBndr id, emptyFVs)
415 rn_var (RuleBndrSig v t, id) = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
416 returnM (RuleBndrSig id t', fvs)
419 Check the shape of a transformation rule LHS. Currently
420 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
421 not one of the @forall@'d variables. We also restrict the form of the LHS so
422 that it may be plausibly matched. Basically you only get to write ordinary
423 applications. (E.g. a case expression is not allowed: too elaborate.)
425 NB: if you add new cases here, make sure you add new ones to TcRule.ruleLhsTvs
428 validRuleLhs :: [Name] -> RenamedHsExpr -> Maybe RenamedHsExpr
430 -- Just e => Not ok, and e is the offending expression
431 validRuleLhs foralls lhs
434 check (OpApp e1 op _ e2) = check op `seqMaybe` check_e e1 `seqMaybe` check_e e2
435 check (HsApp e1 e2) = check e1 `seqMaybe` check_e e2
436 check (HsVar v) | v `notElem` foralls = Nothing
437 check other = Just other -- Failure
439 check_e (HsVar v) = Nothing
440 check_e (HsPar e) = check_e e
441 check_e (HsLit e) = Nothing
442 check_e (HsOverLit e) = Nothing
444 check_e (OpApp e1 op _ e2) = check_e e1 `seqMaybe` check_e op `seqMaybe` check_e e2
445 check_e (HsApp e1 e2) = check_e e1 `seqMaybe` check_e e2
446 check_e (NegApp e _) = check_e e
447 check_e (ExplicitList _ es) = check_es es
448 check_e (ExplicitTuple es _) = check_es es
449 check_e other = Just other -- Fails
451 check_es es = foldr (seqMaybe . check_e) Nothing es
455 %*********************************************************
457 \subsection{Type, class and iface sig declarations}
459 %*********************************************************
461 @rnTyDecl@ uses the `global name function' to create a new type
462 declaration in which local names have been replaced by their original
463 names, reporting any unknown names.
465 Renaming type variables is a pain. Because they now contain uniques,
466 it is necessary to pass in an association list which maps a parsed
467 tyvar to its @Name@ representation.
468 In some cases (type signatures of values),
469 it is even necessary to go over the type first
470 in order to get the set of tyvars used by it, make an assoc list,
471 and then go over it again to rename the tyvars!
472 However, we can also do some scoping checks at the same time.
475 rnTyClDecl (IfaceSig {tcdName = name, tcdType = ty, tcdIdInfo = id_infos, tcdLoc = loc})
477 lookupTopBndrRn name `thenM` \ name' ->
478 rnHsType doc_str ty `thenM` \ ty' ->
479 mappM rnIdInfo id_infos `thenM` \ id_infos' ->
480 returnM (IfaceSig {tcdName = name', tcdType = ty', tcdIdInfo = id_infos', tcdLoc = loc})
482 doc_str = text "In the interface signature for" <+> quotes (ppr name)
484 rnTyClDecl (ForeignType {tcdName = name, tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
486 lookupTopBndrRn name `thenM` \ name' ->
487 returnM (ForeignType {tcdName = name', tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
489 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
490 tcdTyVars = tyvars, tcdCons = condecls, tcdGeneric = want_generic,
491 tcdDerivs = derivs, tcdLoc = src_loc})
492 = addSrcLoc src_loc $
493 lookupTopBndrRn tycon `thenM` \ tycon' ->
494 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
495 rnContext data_doc context `thenM` \ context' ->
496 rn_derivs derivs `thenM` \ derivs' ->
497 checkDupOrQualNames data_doc con_names `thenM_`
499 rnConDecls tycon' condecls `thenM` \ condecls' ->
500 returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdName = tycon',
501 tcdTyVars = tyvars', tcdCons = condecls', tcdGeneric = want_generic,
502 tcdDerivs = derivs', tcdLoc = src_loc})
504 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
505 con_names = map conDeclName (visibleDataCons condecls)
507 rn_derivs Nothing = returnM Nothing
508 rn_derivs (Just ds) = rnContext data_doc ds `thenM` \ ds' -> returnM (Just ds')
510 rnTyClDecl (TySynonym {tcdName = name, tcdTyVars = tyvars, tcdSynRhs = ty, tcdLoc = src_loc})
511 = addSrcLoc src_loc $
512 lookupTopBndrRn name `thenM` \ name' ->
513 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
514 rnHsType syn_doc ty `thenM` \ ty' ->
515 returnM (TySynonym {tcdName = name', tcdTyVars = tyvars', tcdSynRhs = ty', tcdLoc = src_loc})
517 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
519 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
520 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
522 -- Used for both source and interface file decls
523 = addSrcLoc src_loc $
525 lookupTopBndrRn cname `thenM` \ cname' ->
527 -- Tyvars scope over superclass context and method signatures
528 bindTyVarsRn cls_doc tyvars $ \ tyvars' ->
530 -- Check the superclasses
531 rnContext cls_doc context `thenM` \ context' ->
533 -- Check the functional dependencies
534 rnFds cls_doc fds `thenM` \ fds' ->
536 -- Check the signatures
537 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
539 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
540 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
542 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenM_`
543 mappM (rnClassOp cname' fds') op_sigs `thenM` \ sigs' ->
545 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
547 renameSigs (okClsDclSig binders) non_op_sigs `thenM` \ non_ops' ->
549 -- Typechecker is responsible for checking that we only
550 -- give default-method bindings for things in this class.
551 -- The renamer *could* check this for class decls, but can't
552 -- for instance decls.
554 returnM (ClassDecl { tcdCtxt = context', tcdName = cname', tcdTyVars = tyvars',
555 tcdFDs = fds', tcdSigs = non_ops' ++ sigs', tcdMeths = Nothing,
558 cls_doc = text "In the declaration for class" <+> ppr cname
559 sig_doc = text "In the signatures for class" <+> ppr cname
561 rnClassOp clas clas_fds sig@(ClassOpSig op dm_stuff ty locn)
563 lookupTopBndrRn op `thenM` \ op_name ->
565 -- Check the signature
566 rnHsSigType (quotes (ppr op)) ty `thenM` \ new_ty ->
568 -- Make the default-method name
571 -> -- Imported class that has a default method decl
572 lookupSysBndr dm_rdr_name `thenM` \ dm_name ->
573 returnM (DefMeth dm_name)
574 -- An imported class decl for a class decl that had an explicit default
575 -- method, mentions, rather than defines,
576 -- the default method, so we must arrange to pull it in
578 GenDefMeth -> returnM GenDefMeth
579 NoDefMeth -> returnM NoDefMeth
580 ) `thenM` \ dm_stuff' ->
582 returnM (ClassOpSig op_name dm_stuff' new_ty locn)
584 finishSourceTyClDecl :: RdrNameTyClDecl -> RenamedTyClDecl -> RnM (RenamedTyClDecl, FreeVars)
585 -- Used for source file decls only
586 -- Renames the default-bindings of a class decl
587 finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc}) -- Get mbinds from here
588 rn_cls_decl@(ClassDecl {tcdName = cls, tcdTyVars = tyvars}) -- Everything else is here
589 -- There are some default-method bindings (abeit possibly empty) so
590 -- this is a source-code class declaration
591 = -- The newLocals call is tiresome: given a generic class decl
594 -- op {| x+y |} (Inl a) = ...
595 -- op {| x+y |} (Inr b) = ...
596 -- op {| a*b |} (a*b) = ...
597 -- we want to name both "x" tyvars with the same unique, so that they are
598 -- easy to group together in the typechecker.
601 extendTyVarEnvForMethodBinds tyvars $
602 getLocalRdrEnv `thenM` \ name_env ->
604 meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
605 gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
606 not (tv `elemRdrEnv` name_env)]
608 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenM_`
609 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
610 rnMethodBinds cls gen_tyvars mbinds `thenM` \ (mbinds', meth_fvs) ->
611 returnM (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)
613 meth_doc = text "In the default-methods for class" <+> ppr (tcdName rn_cls_decl)
615 finishSourceTyClDecl _ tycl_decl@(TyData {tcdDerivs = derivings})
616 -- Derivings are returned here so that they don't form part of the tyClDeclFVs.
617 -- This is important, because tyClDeclFVs should contain only the
618 -- FVs that are `needed' by the interface file declaration, and
619 -- derivings do not appear in this. It also means that the tcGroups
620 -- are smaller, which turned out to be important for the usage inference. KSW 2002-02.
621 = returnM (tycl_decl,
622 maybe emptyFVs extractHsCtxtTyNames derivings)
624 finishSourceTyClDecl _ tycl_decl = returnM (tycl_decl, emptyFVs)
625 -- Not a class declaration
628 For the method bindings in class and instance decls, we extend the
629 type variable environment iff -fglasgow-exts
632 extendTyVarEnvForMethodBinds tyvars thing_inside
633 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
634 if opt_GlasgowExts then
635 extendTyVarEnvFVRn (map hsTyVarName tyvars) thing_inside
641 %*********************************************************
643 \subsection{Support code for type/data declarations}
645 %*********************************************************
648 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
649 conDeclName (ConDecl n _ _ _ l) = (n,l)
651 rnConDecls :: Name -> DataConDetails RdrNameConDecl -> RnM (DataConDetails RenamedConDecl)
652 rnConDecls tycon Unknown = returnM Unknown
653 rnConDecls tycon (HasCons n) = returnM (HasCons n)
654 rnConDecls tycon (DataCons condecls)
655 = -- Check that there's at least one condecl,
656 -- or else we're reading an interface file, or -fglasgow-exts
657 (if null condecls then
658 doptM Opt_GlasgowExts `thenM` \ glaExts ->
659 getModeRn `thenM` \ mode ->
660 checkErr (glaExts || isInterfaceMode mode)
661 (emptyConDeclsErr tycon)
665 mappM rnConDecl condecls `thenM` \ condecls' ->
666 returnM (DataCons condecls')
668 rnConDecl :: RdrNameConDecl -> RnM RenamedConDecl
669 rnConDecl (ConDecl name tvs cxt details locn)
671 checkConName name `thenM_`
672 lookupTopBndrRn name `thenM` \ new_name ->
674 bindTyVarsRn doc tvs $ \ new_tyvars ->
675 rnContext doc cxt `thenM` \ new_context ->
676 rnConDetails doc locn details `thenM` \ new_details ->
677 returnM (ConDecl new_name new_tyvars new_context new_details locn)
679 doc = text "In the definition of data constructor" <+> quotes (ppr name)
681 rnConDetails doc locn (PrefixCon tys)
682 = mappM (rnBangTy doc) tys `thenM` \ new_tys ->
683 returnM (PrefixCon new_tys)
685 rnConDetails doc locn (InfixCon ty1 ty2)
686 = rnBangTy doc ty1 `thenM` \ new_ty1 ->
687 rnBangTy doc ty2 `thenM` \ new_ty2 ->
688 returnM (InfixCon new_ty1 new_ty2)
690 rnConDetails doc locn (RecCon fields)
691 = checkDupOrQualNames doc field_names `thenM_`
692 mappM (rnField doc) fields `thenM` \ new_fields ->
693 returnM (RecCon new_fields)
695 field_names = [(fld, locn) | (fld, _) <- fields]
697 rnField doc (name, ty)
698 = lookupTopBndrRn name `thenM` \ new_name ->
699 rnBangTy doc ty `thenM` \ new_ty ->
700 returnM (new_name, new_ty)
702 rnBangTy doc (BangType s ty)
703 = rnHsType doc ty `thenM` \ new_ty ->
704 returnM (BangType s new_ty)
706 -- This data decl will parse OK
708 -- treating "a" as the constructor.
709 -- It is really hard to make the parser spot this malformation.
710 -- So the renamer has to check that the constructor is legal
712 -- We can get an operator as the constructor, even in the prefix form:
713 -- data T = :% Int Int
714 -- from interface files, which always print in prefix form
717 = checkErr (isRdrDataCon name) (badDataCon name)
721 %*********************************************************
723 \subsection{Support code to rename types}
725 %*********************************************************
728 rnFds :: SDoc -> [FunDep RdrName] -> RnM [FunDep Name]
734 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
735 rnHsTyVars doc tys2 `thenM` \ tys2' ->
736 returnM (tys1', tys2')
738 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
739 rnHsTyvar doc tyvar = lookupOccRn tyvar
742 %*********************************************************
746 %*********************************************************
749 rnIdInfo (HsWorker worker arity)
750 = lookupOccRn worker `thenM` \ worker' ->
751 returnM (HsWorker worker' arity)
753 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenM` \ expr' ->
754 returnM (HsUnfold inline expr')
755 rnIdInfo (HsStrictness str) = returnM (HsStrictness str)
756 rnIdInfo (HsArity arity) = returnM (HsArity arity)
757 rnIdInfo HsNoCafRefs = returnM HsNoCafRefs
760 @UfCore@ expressions.
763 rnCoreExpr (UfType ty)
764 = rnHsType (text "unfolding type") ty `thenM` \ ty' ->
768 = lookupOccRn v `thenM` \ v' ->
774 rnCoreExpr (UfLitLit l ty)
775 = rnHsType (text "litlit") ty `thenM` \ ty' ->
776 returnM (UfLitLit l ty')
778 rnCoreExpr (UfFCall cc ty)
779 = rnHsType (text "ccall") ty `thenM` \ ty' ->
780 returnM (UfFCall cc ty')
782 rnCoreExpr (UfTuple (HsTupCon boxity arity) args)
783 = mappM rnCoreExpr args `thenM` \ args' ->
784 returnM (UfTuple (HsTupCon boxity arity) args')
786 rnCoreExpr (UfApp fun arg)
787 = rnCoreExpr fun `thenM` \ fun' ->
788 rnCoreExpr arg `thenM` \ arg' ->
789 returnM (UfApp fun' arg')
791 rnCoreExpr (UfCase scrut bndr alts)
792 = rnCoreExpr scrut `thenM` \ scrut' ->
793 bindCoreLocalRn bndr $ \ bndr' ->
794 mappM rnCoreAlt alts `thenM` \ alts' ->
795 returnM (UfCase scrut' bndr' alts')
797 rnCoreExpr (UfNote note expr)
798 = rnNote note `thenM` \ note' ->
799 rnCoreExpr expr `thenM` \ expr' ->
800 returnM (UfNote note' expr')
802 rnCoreExpr (UfLam bndr body)
803 = rnCoreBndr bndr $ \ bndr' ->
804 rnCoreExpr body `thenM` \ body' ->
805 returnM (UfLam bndr' body')
807 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
808 = rnCoreExpr rhs `thenM` \ rhs' ->
809 rnCoreBndr bndr $ \ bndr' ->
810 rnCoreExpr body `thenM` \ body' ->
811 returnM (UfLet (UfNonRec bndr' rhs') body')
813 rnCoreExpr (UfLet (UfRec pairs) body)
814 = rnCoreBndrs bndrs $ \ bndrs' ->
815 mappM rnCoreExpr rhss `thenM` \ rhss' ->
816 rnCoreExpr body `thenM` \ body' ->
817 returnM (UfLet (UfRec (bndrs' `zip` rhss')) body')
819 (bndrs, rhss) = unzip pairs
823 rnCoreBndr (UfValBinder name ty) thing_inside
824 = rnHsType doc ty `thenM` \ ty' ->
825 bindCoreLocalRn name $ \ name' ->
826 thing_inside (UfValBinder name' ty')
828 doc = text "unfolding id"
830 rnCoreBndr (UfTyBinder name kind) thing_inside
831 = bindCoreLocalRn name $ \ name' ->
832 thing_inside (UfTyBinder name' kind)
834 rnCoreBndrs [] thing_inside = thing_inside []
835 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
836 rnCoreBndrs bs $ \ names' ->
837 thing_inside (name':names')
841 rnCoreAlt (con, bndrs, rhs)
842 = rnUfCon con `thenM` \ con' ->
843 bindCoreLocalsRn bndrs $ \ bndrs' ->
844 rnCoreExpr rhs `thenM` \ rhs' ->
845 returnM (con', bndrs', rhs')
848 = rnHsType (text "unfolding coerce") ty `thenM` \ ty' ->
849 returnM (UfCoerce ty')
851 rnNote (UfSCC cc) = returnM (UfSCC cc)
852 rnNote UfInlineCall = returnM UfInlineCall
853 rnNote UfInlineMe = returnM UfInlineMe
859 rnUfCon (UfTupleAlt tup_con)
860 = returnM (UfTupleAlt tup_con)
862 rnUfCon (UfDataAlt con)
863 = lookupOccRn con `thenM` \ con' ->
864 returnM (UfDataAlt con')
866 rnUfCon (UfLitAlt lit)
867 = returnM (UfLitAlt lit)
869 rnUfCon (UfLitLitAlt lit ty)
870 = rnHsType (text "litlit") ty `thenM` \ ty' ->
871 returnM (UfLitLitAlt lit ty')
874 %*********************************************************
876 \subsection{Statistics}
878 %*********************************************************
881 rnStats :: [RenamedHsDecl] -- Imported decls
884 = doptM Opt_D_dump_rn_trace `thenM` \ dump_rn_trace ->
885 doptM Opt_D_dump_rn_stats `thenM` \ dump_rn_stats ->
886 doptM Opt_D_dump_rn `thenM` \ dump_rn ->
887 getEps `thenM` \ eps ->
889 ioToTcRn (dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
891 (getRnStats eps imp_decls)) `thenM_`
894 getRnStats :: ExternalPackageState -> [RenamedHsDecl] -> SDoc
895 getRnStats eps imported_decls
896 = hcat [text "Renamer stats: ", stats]
898 n_mods = length [() | _ <- moduleEnvElts (eps_PIT eps)]
899 -- This is really only right for a one-shot compile
901 (decls_map, n_decls_slurped) = eps_decls eps
903 n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
904 -- Data, newtype, and class decls are in the decls_fm
905 -- under multiple names; the tycon/class, and each
906 -- constructor/class op too.
907 -- The 'True' selects just the 'main' decl
910 (insts_left, n_insts_slurped) = eps_insts eps
911 n_insts_left = length (bagToList insts_left)
913 (rules_left, n_rules_slurped) = eps_rules eps
914 n_rules_left = length (bagToList rules_left)
917 [int n_mods <+> text "interfaces read",
918 hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
919 int (n_decls_slurped + n_decls_left), text "read"],
920 hsep [ int n_insts_slurped, text "instance decls imported, out of",
921 int (n_insts_slurped + n_insts_left), text "read"],
922 hsep [ int n_rules_slurped, text "rule decls imported, out of",
923 int (n_rules_slurped + n_rules_left), text "read"]
927 %*********************************************************
931 %*********************************************************
935 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
937 badRuleLhsErr name lhs (Just bad_e)
938 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
939 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
940 ptext SLIT("in left-hand side:") <+> ppr lhs])]
942 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
945 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
946 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
947 ptext SLIT("does not appear on left hand side")]
949 emptyConDeclsErr tycon
950 = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
951 nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]