2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
8 rnSrcDecls, checkModDeprec,
9 rnTyClDecl, rnIfaceRuleDecl, rnInstDecl,
10 rnBinds, rnBindsAndThen, rnStats,
13 #include "HsVersions.h"
16 import RdrName ( RdrName, isRdrDataCon, elemRdrEnv )
17 import RdrHsSyn ( RdrNameConDecl, RdrNameTyClDecl,
18 RdrNameDeprecation, RdrNameFixitySig,
20 extractGenericPatTyVars
24 import RnExpr ( rnExpr )
25 import RnTypes ( rnHsType, rnHsSigType, rnHsTypeFVs, rnContext )
27 import RnBinds ( rnTopMonoBinds, rnMonoBinds, rnMethodBinds,
28 rnMonoBindsAndThen, renameSigs, checkSigs )
29 import RnEnv ( lookupTopBndrRn, lookupOccRn, lookupSysBndr,
30 newLocalsRn, lookupGlobalOccRn,
31 bindLocalsFVRn, bindPatSigTyVars,
32 bindTyVarsRn, extendTyVarEnvFVRn,
33 bindCoreLocalRn, bindCoreLocalsRn, bindLocalNames,
34 checkDupOrQualNames, checkDupNames, mapFvRn,
35 lookupTopSrcBndr_maybe, lookupTopSrcBndr,
36 dataTcOccs, unknownNameErr
40 import BasicTypes ( FixitySig(..) )
41 import HscTypes ( ExternalPackageState(..), FixityEnv,
42 Deprecations(..), plusDeprecs )
43 import Module ( moduleEnvElts )
44 import Class ( FunDep, DefMeth (..) )
45 import TyCon ( DataConDetails(..), visibleDataCons )
49 import ErrUtils ( dumpIfSet )
50 import PrelNames ( newStablePtrName, bindIOName, returnIOName )
51 import List ( partition )
52 import Bag ( bagToList )
54 import SrcLoc ( SrcLoc )
55 import CmdLineOpts ( DynFlag(..) )
56 -- Warn of unused for-all'd tyvars
57 import Maybes ( maybeToBool, seqMaybe )
58 import Maybe ( maybe, catMaybes, isNothing )
61 @rnSourceDecl@ `renames' declarations.
62 It simultaneously performs dependency analysis and precedence parsing.
63 It also does the following error checks:
66 Checks that tyvars are used properly. This includes checking
67 for undefined tyvars, and tyvars in contexts that are ambiguous.
68 (Some of this checking has now been moved to module @TcMonoType@,
69 since we don't have functional dependency information at this point.)
71 Checks that all variable occurences are defined.
73 Checks the @(..)@ etc constraints in the export list.
78 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name, FreeVars)
80 rnSrcDecls (HsGroup { hs_valds = MonoBind binds sigs _,
81 hs_tyclds = tycl_decls,
82 hs_instds = inst_decls,
84 hs_depds = deprec_decls,
85 hs_fords = foreign_decls,
86 hs_defds = default_decls,
87 hs_ruleds = rule_decls,
88 hs_coreds = core_decls })
90 = do { -- Deal with deprecations (returns only the extra deprecations)
91 deprecs <- rnSrcDeprecDecls deprec_decls ;
92 updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
95 -- Deal with top-level fixity decls
96 -- (returns the total new fixity env)
97 fix_env <- rnSrcFixityDecls fix_decls ;
98 updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
101 failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
103 -- Rename other declarations
104 (rn_val_decls, src_fvs1) <- rnTopMonoBinds binds sigs ;
105 (rn_inst_decls, src_fvs2) <- mapFvRn rnSrcInstDecl inst_decls ;
106 (rn_tycl_decls, src_fvs3) <- mapFvRn rnSrcTyClDecl tycl_decls ;
107 (rn_rule_decls, src_fvs4) <- mapFvRn rnHsRuleDecl rule_decls ;
108 (rn_foreign_decls, src_fvs5) <- mapFvRn rnHsForeignDecl foreign_decls ;
109 (rn_default_decls, src_fvs6) <- mapFvRn rnDefaultDecl default_decls ;
110 (rn_core_decls, src_fvs7) <- mapFvRn rnCoreDecl core_decls ;
113 rn_group = HsGroup { hs_valds = rn_val_decls,
114 hs_tyclds = rn_tycl_decls,
115 hs_instds = rn_inst_decls,
118 hs_fords = rn_foreign_decls,
119 hs_defds = rn_default_decls,
120 hs_ruleds = rn_rule_decls,
121 hs_coreds = rn_core_decls } ;
122 src_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4,
123 src_fvs5, src_fvs6, src_fvs7] } ;
125 traceRn (text "rnSrcDecls" <+> ppr (nameSetToList src_fvs)) ;
126 tcg_env <- getGblEnv ;
127 return (tcg_env, rn_group, src_fvs)
132 %*********************************************************
134 Source-code fixity declarations
136 %*********************************************************
139 rnSrcFixityDecls :: [RdrNameFixitySig] -> TcRn m FixityEnv
140 rnSrcFixityDecls fix_decls
141 = getGblEnv `thenM` \ gbl_env ->
142 foldlM rnFixityDecl (tcg_fix_env gbl_env)
143 fix_decls `thenM` \ fix_env ->
144 traceRn (text "fixity env" <+> ppr fix_env) `thenM_`
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 rnSrcTyClDecl tycl_decl
215 = rnTyClDecl tycl_decl `thenM` \ new_decl ->
216 finishSourceTyClDecl tycl_decl new_decl `thenM` \ (new_decl', fvs) ->
217 returnM (new_decl', fvs `plusFV` tyClDeclFVs new_decl')
220 = rnInstDecl inst `thenM` \ new_inst ->
221 finishSourceInstDecl inst new_inst `thenM` \ (new_inst', fvs) ->
222 returnM (new_inst', fvs `plusFV` instDeclFVs new_inst')
224 rnDefaultDecl (DefaultDecl tys src_loc)
225 = addSrcLoc src_loc $
226 mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
227 returnM (DefaultDecl tys' src_loc, fvs)
229 doc_str = text "In a `default' declaration"
232 rnCoreDecl (CoreDecl name ty rhs loc)
234 lookupTopBndrRn name `thenM` \ name' ->
235 rnHsTypeFVs doc_str ty `thenM` \ (ty', ty_fvs) ->
236 rnCoreExpr rhs `thenM` \ rhs' ->
237 returnM (CoreDecl name' ty' rhs' loc,
238 ty_fvs `plusFV` ufExprFVs rhs')
240 doc_str = text "In the Core declaration for" <+> quotes (ppr name)
243 %*********************************************************
247 %*********************************************************
249 These chaps are here, rather than in TcBinds, so that there
250 is just one hi-boot file (for RnSource). rnSrcDecls is part
251 of the loop too, and it must be defined in this module.
254 rnTopBinds :: RdrNameHsBinds -> RnM (RenamedHsBinds, FreeVars)
255 rnTopBinds EmptyBinds = returnM (EmptyBinds, emptyFVs)
256 rnTopBinds (MonoBind bind sigs _) = rnTopMonoBinds bind sigs
257 -- The parser doesn't produce other forms
259 rnBinds :: RdrNameHsBinds -> RnM (RenamedHsBinds, FreeVars)
260 -- This version assumes that the binders are already in scope
261 rnBinds EmptyBinds = returnM (EmptyBinds, emptyFVs)
262 rnBinds (MonoBind bind sigs _) = rnMonoBinds bind sigs
263 -- The parser doesn't produce other forms
265 rnBindsAndThen :: RdrNameHsBinds
266 -> (RenamedHsBinds -> RnM (result, FreeVars))
267 -> RnM (result, FreeVars)
268 -- This version (a) assumes that the binding vars are not already in scope
269 -- (b) removes the binders from the free vars of the thing inside
270 rnBindsAndThen EmptyBinds thing_inside = thing_inside EmptyBinds
271 rnBindsAndThen (MonoBind bind sigs _) thing_inside = rnMonoBindsAndThen bind sigs thing_inside
272 -- The parser doesn't produce other forms
276 %*********************************************************
278 \subsection{Foreign declarations}
280 %*********************************************************
283 rnHsForeignDecl (ForeignImport name ty spec isDeprec src_loc)
284 = addSrcLoc src_loc $
285 lookupTopBndrRn name `thenM` \ name' ->
286 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
287 returnM (ForeignImport name' ty' spec isDeprec src_loc,
288 fvs `plusFV` extras spec)
290 extras (CImport _ _ _ _ CWrapper) = mkFVs [newStablePtrName,
291 bindIOName, returnIOName]
294 rnHsForeignDecl (ForeignExport name ty spec isDeprec src_loc)
295 = addSrcLoc src_loc $
296 lookupOccRn name `thenM` \ name' ->
297 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
298 returnM (ForeignExport name' ty' spec isDeprec src_loc,
299 mkFVs [name', bindIOName, returnIOName] `plusFV` fvs )
300 -- NB: a foreign export is an *occurrence site* for name, so
301 -- we add it to the free-variable list. It might, for example,
302 -- be imported from another module
304 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
308 %*********************************************************
310 \subsection{Instance declarations}
312 %*********************************************************
315 rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
316 -- Used for both source and interface file decls
317 = addSrcLoc src_loc $
318 rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
320 (case maybe_dfun_rdr_name of
321 Nothing -> returnM Nothing
322 Just dfun_rdr_name -> lookupGlobalOccRn dfun_rdr_name `thenM` \ dfun_name ->
323 returnM (Just dfun_name)
324 ) `thenM` \ maybe_dfun_name ->
326 -- The typechecker checks that all the bindings are for the right class.
327 returnM (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
329 -- Compare finishSourceTyClDecl
330 finishSourceInstDecl (InstDecl _ mbinds uprags _ _ )
331 (InstDecl inst_ty _ _ maybe_dfun_name src_loc)
332 -- Used for both source decls only
333 = ASSERT( not (maybeToBool maybe_dfun_name) ) -- Source decl!
335 meth_doc = text "In the bindings in an instance declaration"
336 meth_names = collectLocatedMonoBinders mbinds
337 (inst_tyvars, _, cls,_) = splitHsInstDeclTy inst_ty
338 -- (Slightly strangely) the forall-d tyvars scope over
339 -- the method bindings too
342 -- Rename the bindings
343 -- NB meth_names can be qualified!
344 checkDupNames meth_doc meth_names `thenM_`
345 extendTyVarEnvForMethodBinds inst_tyvars (
346 rnMethodBinds cls [] mbinds
347 ) `thenM` \ (mbinds', meth_fvs) ->
349 binders = collectMonoBinders mbinds'
351 -- Rename the prags and signatures.
352 -- Note that the type variables are not in scope here,
353 -- so that instance Eq a => Eq (T a) where
354 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
357 -- But the (unqualified) method names are in scope
358 bindLocalNames binders (renameSigs uprags) `thenM` \ uprags' ->
359 checkSigs okInstDclSig (mkNameSet binders) uprags' `thenM_`
361 returnM (InstDecl inst_ty mbinds' uprags' maybe_dfun_name src_loc,
362 meth_fvs `plusFV` hsSigsFVs uprags')
365 %*********************************************************
369 %*********************************************************
372 rnIfaceRuleDecl (IfaceRule rule_name act vars fn args rhs src_loc)
373 = addSrcLoc src_loc $
374 lookupOccRn fn `thenM` \ fn' ->
375 rnCoreBndrs vars $ \ vars' ->
376 mappM rnCoreExpr args `thenM` \ args' ->
377 rnCoreExpr rhs `thenM` \ rhs' ->
378 returnM (IfaceRule rule_name act vars' fn' args' rhs' src_loc)
380 rnIfaceRuleDecl (IfaceRuleOut fn rule) -- Builtin rules come this way
381 = lookupOccRn fn `thenM` \ fn' ->
382 returnM (IfaceRuleOut fn' rule)
384 rnHsRuleDecl (HsRule rule_name act vars lhs rhs src_loc)
385 = addSrcLoc src_loc $
386 bindPatSigTyVars (collectRuleBndrSigTys vars) $
388 bindLocalsFVRn doc (map get_var vars) $ \ ids ->
389 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
391 rnExpr lhs `thenM` \ (lhs', fv_lhs) ->
392 rnExpr rhs `thenM` \ (rhs', fv_rhs) ->
394 mb_bad = validRuleLhs ids lhs'
396 checkErr (isNothing mb_bad)
397 (badRuleLhsErr rule_name lhs' mb_bad) `thenM_`
399 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
401 mappM (addErr . badRuleVar rule_name) bad_vars `thenM_`
402 returnM (HsRule rule_name act vars' lhs' rhs' src_loc,
403 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
405 doc = text "In the transformation rule" <+> ftext rule_name
407 get_var (RuleBndr v) = v
408 get_var (RuleBndrSig v _) = v
410 rn_var (RuleBndr v, id) = returnM (RuleBndr id, emptyFVs)
411 rn_var (RuleBndrSig v t, id) = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
412 returnM (RuleBndrSig id t', fvs)
415 Check the shape of a transformation rule LHS. Currently
416 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
417 not one of the @forall@'d variables. We also restrict the form of the LHS so
418 that it may be plausibly matched. Basically you only get to write ordinary
419 applications. (E.g. a case expression is not allowed: too elaborate.)
421 NB: if you add new cases here, make sure you add new ones to TcRule.ruleLhsTvs
424 validRuleLhs :: [Name] -> RenamedHsExpr -> Maybe RenamedHsExpr
426 -- Just e => Not ok, and e is the offending expression
427 validRuleLhs foralls lhs
430 check (OpApp e1 op _ e2) = check op `seqMaybe` check_e e1 `seqMaybe` check_e e2
431 check (HsApp e1 e2) = check e1 `seqMaybe` check_e e2
432 check (HsVar v) | v `notElem` foralls = Nothing
433 check other = Just other -- Failure
435 check_e (HsVar v) = Nothing
436 check_e (HsPar e) = check_e e
437 check_e (HsLit e) = Nothing
438 check_e (HsOverLit e) = Nothing
440 check_e (OpApp e1 op _ e2) = check_e e1 `seqMaybe` check_e op `seqMaybe` check_e e2
441 check_e (HsApp e1 e2) = check_e e1 `seqMaybe` check_e e2
442 check_e (NegApp e _) = check_e e
443 check_e (ExplicitList _ es) = check_es es
444 check_e (ExplicitTuple es _) = check_es es
445 check_e other = Just other -- Fails
447 check_es es = foldr (seqMaybe . check_e) Nothing es
451 %*********************************************************
453 \subsection{Type, class and iface sig declarations}
455 %*********************************************************
457 @rnTyDecl@ uses the `global name function' to create a new type
458 declaration in which local names have been replaced by their original
459 names, reporting any unknown names.
461 Renaming type variables is a pain. Because they now contain uniques,
462 it is necessary to pass in an association list which maps a parsed
463 tyvar to its @Name@ representation.
464 In some cases (type signatures of values),
465 it is even necessary to go over the type first
466 in order to get the set of tyvars used by it, make an assoc list,
467 and then go over it again to rename the tyvars!
468 However, we can also do some scoping checks at the same time.
471 rnTyClDecl (IfaceSig {tcdName = name, tcdType = ty, tcdIdInfo = id_infos, tcdLoc = loc})
473 lookupTopBndrRn name `thenM` \ name' ->
474 rnHsType doc_str ty `thenM` \ ty' ->
475 mappM rnIdInfo id_infos `thenM` \ id_infos' ->
476 returnM (IfaceSig {tcdName = name', tcdType = ty', tcdIdInfo = id_infos', tcdLoc = loc})
478 doc_str = text "In the interface signature for" <+> quotes (ppr name)
480 rnTyClDecl (ForeignType {tcdName = name, tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
482 lookupTopBndrRn name `thenM` \ name' ->
483 returnM (ForeignType {tcdName = name', tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
485 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
486 tcdTyVars = tyvars, tcdCons = condecls, tcdGeneric = want_generic,
487 tcdDerivs = derivs, tcdLoc = src_loc})
488 = addSrcLoc src_loc $
489 lookupTopBndrRn tycon `thenM` \ tycon' ->
490 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
491 rnContext data_doc context `thenM` \ context' ->
492 rn_derivs derivs `thenM` \ derivs' ->
493 checkDupOrQualNames data_doc con_names `thenM_`
495 rnConDecls tycon' condecls `thenM` \ condecls' ->
496 returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdName = tycon',
497 tcdTyVars = tyvars', tcdCons = condecls', tcdGeneric = want_generic,
498 tcdDerivs = derivs', tcdLoc = src_loc})
500 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
501 con_names = map conDeclName (visibleDataCons condecls)
503 rn_derivs Nothing = returnM Nothing
504 rn_derivs (Just ds) = rnContext data_doc ds `thenM` \ ds' -> returnM (Just ds')
506 rnTyClDecl (TySynonym {tcdName = name, tcdTyVars = tyvars, tcdSynRhs = ty, tcdLoc = src_loc})
507 = addSrcLoc src_loc $
508 lookupTopBndrRn name `thenM` \ name' ->
509 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
510 rnHsType syn_doc ty `thenM` \ ty' ->
511 returnM (TySynonym {tcdName = name', tcdTyVars = tyvars', tcdSynRhs = ty', tcdLoc = src_loc})
513 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
515 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
516 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
518 -- Used for both source and interface file decls
519 = addSrcLoc src_loc $
521 lookupTopBndrRn cname `thenM` \ cname' ->
523 -- Tyvars scope over superclass context and method signatures
524 bindTyVarsRn cls_doc tyvars $ \ tyvars' ->
526 -- Check the superclasses
527 rnContext cls_doc context `thenM` \ context' ->
529 -- Check the functional dependencies
530 rnFds cls_doc fds `thenM` \ fds' ->
532 -- Check the signatures
533 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
535 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
536 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
538 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenM_`
539 mappM (rnClassOp cname' fds') op_sigs `thenM` \ sigs' ->
541 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
543 renameSigs non_op_sigs `thenM` \ non_ops' ->
544 checkSigs okClsDclSig binders non_ops' `thenM_`
545 -- Typechecker is responsible for checking that we only
546 -- give default-method bindings for things in this class.
547 -- The renamer *could* check this for class decls, but can't
548 -- for instance decls.
550 returnM (ClassDecl { tcdCtxt = context', tcdName = cname', tcdTyVars = tyvars',
551 tcdFDs = fds', tcdSigs = non_ops' ++ sigs', tcdMeths = Nothing,
554 cls_doc = text "In the declaration for class" <+> ppr cname
555 sig_doc = text "In the signatures for class" <+> ppr cname
557 rnClassOp clas clas_fds sig@(ClassOpSig op dm_stuff ty locn)
559 lookupTopBndrRn op `thenM` \ op_name ->
561 -- Check the signature
562 rnHsSigType (quotes (ppr op)) ty `thenM` \ new_ty ->
564 -- Make the default-method name
567 -> -- Imported class that has a default method decl
568 lookupSysBndr dm_rdr_name `thenM` \ dm_name ->
569 returnM (DefMeth dm_name)
570 -- An imported class decl for a class decl that had an explicit default
571 -- method, mentions, rather than defines,
572 -- the default method, so we must arrange to pull it in
574 GenDefMeth -> returnM GenDefMeth
575 NoDefMeth -> returnM NoDefMeth
576 ) `thenM` \ dm_stuff' ->
578 returnM (ClassOpSig op_name dm_stuff' new_ty locn)
580 finishSourceTyClDecl :: RdrNameTyClDecl -> RenamedTyClDecl -> RnM (RenamedTyClDecl, FreeVars)
581 -- Used for source file decls only
582 -- Renames the default-bindings of a class decl
583 finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc}) -- Get mbinds from here
584 rn_cls_decl@(ClassDecl {tcdName = cls, tcdTyVars = tyvars}) -- Everything else is here
585 -- There are some default-method bindings (abeit possibly empty) so
586 -- this is a source-code class declaration
587 = -- The newLocals call is tiresome: given a generic class decl
590 -- op {| x+y |} (Inl a) = ...
591 -- op {| x+y |} (Inr b) = ...
592 -- op {| a*b |} (a*b) = ...
593 -- we want to name both "x" tyvars with the same unique, so that they are
594 -- easy to group together in the typechecker.
597 extendTyVarEnvForMethodBinds tyvars $
598 getLocalRdrEnv `thenM` \ name_env ->
600 meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
601 gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
602 not (tv `elemRdrEnv` name_env)]
604 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenM_`
605 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
606 rnMethodBinds cls gen_tyvars mbinds `thenM` \ (mbinds', meth_fvs) ->
607 returnM (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)
609 meth_doc = text "In the default-methods for class" <+> ppr (tcdName rn_cls_decl)
611 finishSourceTyClDecl _ tycl_decl@(TyData {tcdDerivs = derivings})
612 -- Derivings are returned here so that they don't form part of the tyClDeclFVs.
613 -- This is important, because tyClDeclFVs should contain only the
614 -- FVs that are `needed' by the interface file declaration, and
615 -- derivings do not appear in this. It also means that the tcGroups
616 -- are smaller, which turned out to be important for the usage inference. KSW 2002-02.
617 = returnM (tycl_decl,
618 maybe emptyFVs extractHsCtxtTyNames derivings)
620 finishSourceTyClDecl _ tycl_decl = returnM (tycl_decl, emptyFVs)
621 -- Not a class declaration
624 For the method bindings in class and instance decls, we extend the
625 type variable environment iff -fglasgow-exts
628 extendTyVarEnvForMethodBinds tyvars thing_inside
629 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
630 if opt_GlasgowExts then
631 extendTyVarEnvFVRn (map hsTyVarName tyvars) thing_inside
637 %*********************************************************
639 \subsection{Support code for type/data declarations}
641 %*********************************************************
644 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
645 conDeclName (ConDecl n _ _ _ l) = (n,l)
647 rnConDecls :: Name -> DataConDetails RdrNameConDecl -> RnM (DataConDetails RenamedConDecl)
648 rnConDecls tycon Unknown = returnM Unknown
649 rnConDecls tycon (HasCons n) = returnM (HasCons n)
650 rnConDecls tycon (DataCons condecls)
651 = -- Check that there's at least one condecl,
652 -- or else we're reading an interface file, or -fglasgow-exts
653 (if null condecls then
654 doptM Opt_GlasgowExts `thenM` \ glaExts ->
655 getModeRn `thenM` \ mode ->
656 checkErr (glaExts || isInterfaceMode mode)
657 (emptyConDeclsErr tycon)
661 mappM rnConDecl condecls `thenM` \ condecls' ->
662 returnM (DataCons condecls')
664 rnConDecl :: RdrNameConDecl -> RnM RenamedConDecl
665 rnConDecl (ConDecl name tvs cxt details locn)
667 checkConName name `thenM_`
668 lookupTopBndrRn name `thenM` \ new_name ->
670 bindTyVarsRn doc tvs $ \ new_tyvars ->
671 rnContext doc cxt `thenM` \ new_context ->
672 rnConDetails doc locn details `thenM` \ new_details ->
673 returnM (ConDecl new_name new_tyvars new_context new_details locn)
675 doc = text "In the definition of data constructor" <+> quotes (ppr name)
677 rnConDetails doc locn (PrefixCon tys)
678 = mappM (rnBangTy doc) tys `thenM` \ new_tys ->
679 returnM (PrefixCon new_tys)
681 rnConDetails doc locn (InfixCon ty1 ty2)
682 = rnBangTy doc ty1 `thenM` \ new_ty1 ->
683 rnBangTy doc ty2 `thenM` \ new_ty2 ->
684 returnM (InfixCon new_ty1 new_ty2)
686 rnConDetails doc locn (RecCon fields)
687 = checkDupOrQualNames doc field_names `thenM_`
688 mappM (rnField doc) fields `thenM` \ new_fields ->
689 returnM (RecCon new_fields)
691 field_names = [(fld, locn) | (fld, _) <- fields]
693 rnField doc (name, ty)
694 = lookupTopBndrRn name `thenM` \ new_name ->
695 rnBangTy doc ty `thenM` \ new_ty ->
696 returnM (new_name, new_ty)
698 rnBangTy doc (BangType s ty)
699 = rnHsType doc ty `thenM` \ new_ty ->
700 returnM (BangType s new_ty)
702 -- This data decl will parse OK
704 -- treating "a" as the constructor.
705 -- It is really hard to make the parser spot this malformation.
706 -- So the renamer has to check that the constructor is legal
708 -- We can get an operator as the constructor, even in the prefix form:
709 -- data T = :% Int Int
710 -- from interface files, which always print in prefix form
713 = checkErr (isRdrDataCon name) (badDataCon name)
717 %*********************************************************
719 \subsection{Support code to rename types}
721 %*********************************************************
724 rnFds :: SDoc -> [FunDep RdrName] -> RnM [FunDep Name]
730 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
731 rnHsTyVars doc tys2 `thenM` \ tys2' ->
732 returnM (tys1', tys2')
734 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
735 rnHsTyvar doc tyvar = lookupOccRn tyvar
738 %*********************************************************
742 %*********************************************************
745 rnIdInfo (HsWorker worker arity)
746 = lookupOccRn worker `thenM` \ worker' ->
747 returnM (HsWorker worker' arity)
749 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenM` \ expr' ->
750 returnM (HsUnfold inline expr')
751 rnIdInfo (HsStrictness str) = returnM (HsStrictness str)
752 rnIdInfo (HsArity arity) = returnM (HsArity arity)
753 rnIdInfo HsNoCafRefs = returnM HsNoCafRefs
756 @UfCore@ expressions.
759 rnCoreExpr (UfType ty)
760 = rnHsType (text "unfolding type") ty `thenM` \ ty' ->
764 = lookupOccRn v `thenM` \ v' ->
770 rnCoreExpr (UfLitLit l ty)
771 = rnHsType (text "litlit") ty `thenM` \ ty' ->
772 returnM (UfLitLit l ty')
774 rnCoreExpr (UfFCall cc ty)
775 = rnHsType (text "ccall") ty `thenM` \ ty' ->
776 returnM (UfFCall cc ty')
778 rnCoreExpr (UfTuple (HsTupCon boxity arity) args)
779 = mappM rnCoreExpr args `thenM` \ args' ->
780 returnM (UfTuple (HsTupCon boxity arity) args')
782 rnCoreExpr (UfApp fun arg)
783 = rnCoreExpr fun `thenM` \ fun' ->
784 rnCoreExpr arg `thenM` \ arg' ->
785 returnM (UfApp fun' arg')
787 rnCoreExpr (UfCase scrut bndr alts)
788 = rnCoreExpr scrut `thenM` \ scrut' ->
789 bindCoreLocalRn bndr $ \ bndr' ->
790 mappM rnCoreAlt alts `thenM` \ alts' ->
791 returnM (UfCase scrut' bndr' alts')
793 rnCoreExpr (UfNote note expr)
794 = rnNote note `thenM` \ note' ->
795 rnCoreExpr expr `thenM` \ expr' ->
796 returnM (UfNote note' expr')
798 rnCoreExpr (UfLam bndr body)
799 = rnCoreBndr bndr $ \ bndr' ->
800 rnCoreExpr body `thenM` \ body' ->
801 returnM (UfLam bndr' body')
803 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
804 = rnCoreExpr rhs `thenM` \ rhs' ->
805 rnCoreBndr bndr $ \ bndr' ->
806 rnCoreExpr body `thenM` \ body' ->
807 returnM (UfLet (UfNonRec bndr' rhs') body')
809 rnCoreExpr (UfLet (UfRec pairs) body)
810 = rnCoreBndrs bndrs $ \ bndrs' ->
811 mappM rnCoreExpr rhss `thenM` \ rhss' ->
812 rnCoreExpr body `thenM` \ body' ->
813 returnM (UfLet (UfRec (bndrs' `zip` rhss')) body')
815 (bndrs, rhss) = unzip pairs
819 rnCoreBndr (UfValBinder name ty) thing_inside
820 = rnHsType doc ty `thenM` \ ty' ->
821 bindCoreLocalRn name $ \ name' ->
822 thing_inside (UfValBinder name' ty')
824 doc = text "unfolding id"
826 rnCoreBndr (UfTyBinder name kind) thing_inside
827 = bindCoreLocalRn name $ \ name' ->
828 thing_inside (UfTyBinder name' kind)
830 rnCoreBndrs [] thing_inside = thing_inside []
831 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
832 rnCoreBndrs bs $ \ names' ->
833 thing_inside (name':names')
837 rnCoreAlt (con, bndrs, rhs)
838 = rnUfCon con `thenM` \ con' ->
839 bindCoreLocalsRn bndrs $ \ bndrs' ->
840 rnCoreExpr rhs `thenM` \ rhs' ->
841 returnM (con', bndrs', rhs')
844 = rnHsType (text "unfolding coerce") ty `thenM` \ ty' ->
845 returnM (UfCoerce ty')
847 rnNote (UfSCC cc) = returnM (UfSCC cc)
848 rnNote UfInlineCall = returnM UfInlineCall
849 rnNote UfInlineMe = returnM UfInlineMe
855 rnUfCon (UfTupleAlt tup_con)
856 = returnM (UfTupleAlt tup_con)
858 rnUfCon (UfDataAlt con)
859 = lookupOccRn con `thenM` \ con' ->
860 returnM (UfDataAlt con')
862 rnUfCon (UfLitAlt lit)
863 = returnM (UfLitAlt lit)
865 rnUfCon (UfLitLitAlt lit ty)
866 = rnHsType (text "litlit") ty `thenM` \ ty' ->
867 returnM (UfLitLitAlt lit ty')
870 %*********************************************************
872 \subsection{Statistics}
874 %*********************************************************
877 rnStats :: [RenamedHsDecl] -- Imported decls
880 = doptM Opt_D_dump_rn_trace `thenM` \ dump_rn_trace ->
881 doptM Opt_D_dump_rn_stats `thenM` \ dump_rn_stats ->
882 doptM Opt_D_dump_rn `thenM` \ dump_rn ->
883 getEps `thenM` \ eps ->
885 ioToTcRn (dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
887 (getRnStats eps imp_decls)) `thenM_`
890 getRnStats :: ExternalPackageState -> [RenamedHsDecl] -> SDoc
891 getRnStats eps imported_decls
892 = hcat [text "Renamer stats: ", stats]
894 n_mods = length [() | _ <- moduleEnvElts (eps_PIT eps)]
895 -- This is really only right for a one-shot compile
897 (decls_map, n_decls_slurped) = eps_decls eps
899 n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
900 -- Data, newtype, and class decls are in the decls_fm
901 -- under multiple names; the tycon/class, and each
902 -- constructor/class op too.
903 -- The 'True' selects just the 'main' decl
906 (insts_left, n_insts_slurped) = eps_insts eps
907 n_insts_left = length (bagToList insts_left)
909 (rules_left, n_rules_slurped) = eps_rules eps
910 n_rules_left = length (bagToList rules_left)
913 [int n_mods <+> text "interfaces read",
914 hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
915 int (n_decls_slurped + n_decls_left), text "read"],
916 hsep [ int n_insts_slurped, text "instance decls imported, out of",
917 int (n_insts_slurped + n_insts_left), text "read"],
918 hsep [ int n_rules_slurped, text "rule decls imported, out of",
919 int (n_rules_slurped + n_rules_left), text "read"]
923 %*********************************************************
927 %*********************************************************
931 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
933 badRuleLhsErr name lhs (Just bad_e)
934 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
935 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
936 ptext SLIT("in left-hand side:") <+> ppr lhs])]
938 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
941 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
942 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
943 ptext SLIT("does not appear on left hand side")]
945 emptyConDeclsErr tycon
946 = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
947 nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]