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 bindLocalsFV, bindPatSigTyVarsFV,
32 bindTyVarsRn, extendTyVarEnvFVRn,
33 bindCoreLocalRn, bindCoreLocalsRn, bindLocalNames,
34 checkDupOrQualNames, checkDupNames, mapFvRn,
35 lookupTopSrcBndr_maybe, lookupTopSrcBndr,
36 dataTcOccs, newIPName, unknownNameErr
40 import BasicTypes ( FixitySig(..), TopLevelFlag(..) )
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, DefUses)
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 -- Rename other declarations
102 (rn_val_decls, bind_dus) <- rnTopMonoBinds binds sigs ;
104 -- You might think that we could build proper def/use information
105 -- for type and class declarations, but they can be involved
106 -- in mutual recursion across modules, and we only do the SCC
107 -- analysis for them in the type checker.
108 -- So we content ourselves with gathering uses only; that
109 -- means we'll only report a declaration as unused if it isn't
110 -- mentioned at all. Ah well.
111 (rn_tycl_decls, src_fvs1) <- mapFvRn rnSrcTyClDecl tycl_decls ;
112 (rn_inst_decls, src_fvs2) <- mapFvRn rnSrcInstDecl inst_decls ;
113 (rn_rule_decls, src_fvs3) <- mapFvRn rnHsRuleDecl rule_decls ;
114 (rn_foreign_decls, src_fvs4) <- mapFvRn rnHsForeignDecl foreign_decls ;
115 (rn_default_decls, src_fvs5) <- mapFvRn rnDefaultDecl default_decls ;
116 (rn_core_decls, src_fvs6) <- mapFvRn rnCoreDecl core_decls ;
119 rn_group = HsGroup { hs_valds = rn_val_decls,
120 hs_tyclds = rn_tycl_decls,
121 hs_instds = rn_inst_decls,
124 hs_fords = rn_foreign_decls,
125 hs_defds = rn_default_decls,
126 hs_ruleds = rn_rule_decls,
127 hs_coreds = rn_core_decls } ;
129 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3,
130 src_fvs4, src_fvs5, src_fvs6] ;
131 src_dus = bind_dus `plusDU` usesOnly other_fvs
134 tcg_env <- getGblEnv ;
135 return (tcg_env, rn_group, src_dus)
140 %*********************************************************
142 Source-code fixity declarations
144 %*********************************************************
147 rnSrcFixityDecls :: [RdrNameFixitySig] -> TcRn m FixityEnv
148 rnSrcFixityDecls fix_decls
149 = getGblEnv `thenM` \ gbl_env ->
150 foldlM rnFixityDecl (tcg_fix_env gbl_env)
151 fix_decls `thenM` \ fix_env ->
152 traceRn (text "fixity env" <+> ppr fix_env) `thenM_`
155 rnFixityDecl :: FixityEnv -> RdrNameFixitySig -> TcRn m FixityEnv
156 rnFixityDecl fix_env (FixitySig rdr_name fixity loc)
157 = -- GHC extension: look up both the tycon and data con
158 -- for con-like things
159 -- If neither are in scope, report an error; otherwise
160 -- add both to the fixity env
161 mappM lookupTopSrcBndr_maybe (dataTcOccs rdr_name) `thenM` \ maybe_ns ->
162 case catMaybes maybe_ns of
163 [] -> addSrcLoc loc $
164 addErr (unknownNameErr rdr_name) `thenM_`
166 ns -> foldlM add fix_env ns
169 = case lookupNameEnv fix_env name of
170 Just (FixitySig _ _ loc') -> addErr (dupFixityDecl rdr_name loc loc') `thenM_`
172 Nothing -> returnM (extendNameEnv fix_env name (FixitySig name fixity loc))
174 dupFixityDecl rdr_name loc1 loc2
175 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
176 ptext SLIT("at ") <+> ppr loc1,
177 ptext SLIT("and") <+> ppr loc2]
181 %*********************************************************
183 Source-code deprecations declarations
185 %*********************************************************
187 For deprecations, all we do is check that the names are in scope.
188 It's only imported deprecations, dealt with in RnIfaces, that we
189 gather them together.
192 rnSrcDeprecDecls :: [RdrNameDeprecation] -> TcRn m Deprecations
196 rnSrcDeprecDecls decls
197 = mappM rn_deprec decls `thenM` \ pairs ->
198 returnM (DeprecSome (mkNameEnv (catMaybes pairs)))
200 rn_deprec (Deprecation rdr_name txt loc)
202 lookupTopSrcBndr rdr_name `thenM` \ name ->
203 returnM (Just (name, (name,txt)))
205 checkModDeprec :: Maybe DeprecTxt -> Deprecations
206 -- Check for a module deprecation; done once at top level
207 checkModDeprec Nothing = NoDeprecs
208 checkModdeprec (Just txt) = DeprecAll txt
211 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
215 %*********************************************************
217 \subsection{Source code declarations}
219 %*********************************************************
222 rnSrcTyClDecl tycl_decl
223 = rnTyClDecl tycl_decl `thenM` \ new_decl ->
224 finishSourceTyClDecl tycl_decl new_decl `thenM` \ (new_decl', fvs) ->
225 returnM (new_decl', fvs `plusFV` tyClDeclFVs new_decl')
228 = rnInstDecl inst `thenM` \ new_inst ->
229 finishSourceInstDecl inst new_inst `thenM` \ (new_inst', fvs) ->
230 returnM (new_inst', fvs `plusFV` instDeclFVs new_inst')
232 rnDefaultDecl (DefaultDecl tys src_loc)
233 = addSrcLoc src_loc $
234 mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
235 returnM (DefaultDecl tys' src_loc, fvs)
237 doc_str = text "In a `default' declaration"
240 rnCoreDecl (CoreDecl name ty rhs loc)
242 lookupTopBndrRn name `thenM` \ name' ->
243 rnHsTypeFVs doc_str ty `thenM` \ (ty', ty_fvs) ->
244 rnCoreExpr rhs `thenM` \ rhs' ->
245 returnM (CoreDecl name' ty' rhs' loc,
246 ty_fvs `plusFV` ufExprFVs rhs')
248 doc_str = text "In the Core declaration for" <+> quotes (ppr name)
251 %*********************************************************
255 %*********************************************************
257 These chaps are here, rather than in TcBinds, so that there
258 is just one hi-boot file (for RnSource). rnSrcDecls is part
259 of the loop too, and it must be defined in this module.
262 rnBinds :: RdrNameHsBinds -> RnM (RenamedHsBinds, DefUses)
263 -- This version assumes that the binders are already in scope
264 -- It's used only in 'mdo'
265 rnBinds EmptyBinds = returnM (EmptyBinds, emptyDUs)
266 rnBinds (MonoBind bind sigs _) = rnMonoBinds NotTopLevel bind sigs
267 rnBinds b@(IPBinds bind _) = addErr (badIpBinds b) `thenM_`
268 returnM (EmptyBinds, emptyDUs)
270 rnBindsAndThen :: RdrNameHsBinds
271 -> (RenamedHsBinds -> RnM (result, FreeVars))
272 -> RnM (result, FreeVars)
273 -- This version (a) assumes that the binding vars are not already in scope
274 -- (b) removes the binders from the free vars of the thing inside
275 -- The parser doesn't produce ThenBinds
276 rnBindsAndThen EmptyBinds thing_inside = thing_inside EmptyBinds
277 rnBindsAndThen (MonoBind bind sigs _) thing_inside = rnMonoBindsAndThen bind sigs thing_inside
278 rnBindsAndThen (IPBinds binds is_with) thing_inside
279 = warnIf is_with withWarning `thenM_`
280 rnIPBinds binds `thenM` \ (binds',fv_binds) ->
281 thing_inside (IPBinds binds' is_with) `thenM` \ (thing, fvs_thing) ->
282 returnM (thing, fvs_thing `plusFV` fv_binds)
286 %************************************************************************
288 \subsubsection{@rnIPBinds@s: in implicit parameter bindings} *
290 %************************************************************************
293 rnIPBinds [] = returnM ([], emptyFVs)
294 rnIPBinds ((n, expr) : binds)
295 = newIPName n `thenM` \ name ->
296 rnExpr expr `thenM` \ (expr',fvExpr) ->
297 rnIPBinds binds `thenM` \ (binds',fvBinds) ->
298 returnM ((name, expr') : binds', fvExpr `plusFV` fvBinds)
303 %*********************************************************
305 \subsection{Foreign declarations}
307 %*********************************************************
310 rnHsForeignDecl (ForeignImport name ty spec isDeprec src_loc)
311 = addSrcLoc src_loc $
312 lookupTopBndrRn name `thenM` \ name' ->
313 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
314 returnM (ForeignImport name' ty' spec isDeprec src_loc,
315 fvs `plusFV` extras spec)
317 extras (CImport _ _ _ _ CWrapper) = mkFVs [newStablePtrName,
318 bindIOName, returnIOName]
321 rnHsForeignDecl (ForeignExport name ty spec isDeprec src_loc)
322 = addSrcLoc src_loc $
323 lookupOccRn name `thenM` \ name' ->
324 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
325 returnM (ForeignExport name' ty' spec isDeprec src_loc,
326 mkFVs [name', bindIOName, returnIOName] `plusFV` fvs )
327 -- NB: a foreign export is an *occurrence site* for name, so
328 -- we add it to the free-variable list. It might, for example,
329 -- be imported from another module
331 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
335 %*********************************************************
337 \subsection{Instance declarations}
339 %*********************************************************
342 rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
343 -- Used for both source and interface file decls
344 = addSrcLoc src_loc $
345 rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
347 (case maybe_dfun_rdr_name of
348 Nothing -> returnM Nothing
349 Just dfun_rdr_name -> lookupGlobalOccRn dfun_rdr_name `thenM` \ dfun_name ->
350 returnM (Just dfun_name)
351 ) `thenM` \ maybe_dfun_name ->
353 -- The typechecker checks that all the bindings are for the right class.
354 returnM (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
356 -- Compare finishSourceTyClDecl
357 finishSourceInstDecl (InstDecl _ mbinds uprags _ _ )
358 (InstDecl inst_ty _ _ maybe_dfun_name src_loc)
359 -- Used for both source decls only
360 = ASSERT( not (maybeToBool maybe_dfun_name) ) -- Source decl!
362 meth_doc = text "In the bindings in an instance declaration"
363 meth_names = collectLocatedMonoBinders mbinds
364 (inst_tyvars, _, cls,_) = splitHsInstDeclTy inst_ty
365 -- (Slightly strangely) the forall-d tyvars scope over
366 -- the method bindings too
369 -- Rename the bindings
370 -- NB meth_names can be qualified!
371 checkDupNames meth_doc meth_names `thenM_`
372 extendTyVarEnvForMethodBinds inst_tyvars (
373 rnMethodBinds cls [] mbinds
374 ) `thenM` \ (mbinds', meth_fvs) ->
376 binders = collectMonoBinders mbinds'
378 -- Rename the prags and signatures.
379 -- Note that the type variables are not in scope here,
380 -- so that instance Eq a => Eq (T a) where
381 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
384 -- But the (unqualified) method names are in scope
385 bindLocalNames binders (renameSigs uprags) `thenM` \ uprags' ->
386 checkSigs (okInstDclSig (mkNameSet binders)) uprags' `thenM_`
388 returnM (InstDecl inst_ty mbinds' uprags' maybe_dfun_name src_loc,
389 meth_fvs `plusFV` hsSigsFVs uprags')
392 %*********************************************************
396 %*********************************************************
399 rnIfaceRuleDecl (IfaceRule rule_name act vars fn args rhs src_loc)
400 = addSrcLoc src_loc $
401 lookupOccRn fn `thenM` \ fn' ->
402 rnCoreBndrs vars $ \ vars' ->
403 mappM rnCoreExpr args `thenM` \ args' ->
404 rnCoreExpr rhs `thenM` \ rhs' ->
405 returnM (IfaceRule rule_name act vars' fn' args' rhs' src_loc)
407 rnIfaceRuleDecl (IfaceRuleOut fn rule) -- Builtin rules come this way
408 = lookupOccRn fn `thenM` \ fn' ->
409 returnM (IfaceRuleOut fn' rule)
411 rnHsRuleDecl (HsRule rule_name act vars lhs rhs src_loc)
412 = addSrcLoc src_loc $
413 bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
415 bindLocalsFV doc (map get_var vars) $ \ ids ->
416 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
418 rnExpr lhs `thenM` \ (lhs', fv_lhs) ->
419 rnExpr rhs `thenM` \ (rhs', fv_rhs) ->
421 mb_bad = validRuleLhs ids lhs'
423 checkErr (isNothing mb_bad)
424 (badRuleLhsErr rule_name lhs' mb_bad) `thenM_`
426 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
428 mappM (addErr . badRuleVar rule_name) bad_vars `thenM_`
429 returnM (HsRule rule_name act vars' lhs' rhs' src_loc,
430 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
432 doc = text "In the transformation rule" <+> ftext rule_name
434 get_var (RuleBndr v) = v
435 get_var (RuleBndrSig v _) = v
437 rn_var (RuleBndr v, id) = returnM (RuleBndr id, emptyFVs)
438 rn_var (RuleBndrSig v t, id) = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
439 returnM (RuleBndrSig id t', fvs)
442 Check the shape of a transformation rule LHS. Currently
443 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
444 not one of the @forall@'d variables. We also restrict the form of the LHS so
445 that it may be plausibly matched. Basically you only get to write ordinary
446 applications. (E.g. a case expression is not allowed: too elaborate.)
448 NB: if you add new cases here, make sure you add new ones to TcRule.ruleLhsTvs
451 validRuleLhs :: [Name] -> RenamedHsExpr -> Maybe RenamedHsExpr
453 -- Just e => Not ok, and e is the offending expression
454 validRuleLhs foralls lhs
457 check (OpApp e1 op _ e2) = check op `seqMaybe` check_e e1 `seqMaybe` check_e e2
458 check (HsApp e1 e2) = check e1 `seqMaybe` check_e e2
459 check (HsVar v) | v `notElem` foralls = Nothing
460 check other = Just other -- Failure
462 check_e (HsVar v) = Nothing
463 check_e (HsPar e) = check_e e
464 check_e (HsLit e) = Nothing
465 check_e (HsOverLit e) = Nothing
467 check_e (OpApp e1 op _ e2) = check_e e1 `seqMaybe` check_e op `seqMaybe` check_e e2
468 check_e (HsApp e1 e2) = check_e e1 `seqMaybe` check_e e2
469 check_e (NegApp e _) = check_e e
470 check_e (ExplicitList _ es) = check_es es
471 check_e (ExplicitTuple es _) = check_es es
472 check_e other = Just other -- Fails
474 check_es es = foldr (seqMaybe . check_e) Nothing es
478 %*********************************************************
480 \subsection{Type, class and iface sig declarations}
482 %*********************************************************
484 @rnTyDecl@ uses the `global name function' to create a new type
485 declaration in which local names have been replaced by their original
486 names, reporting any unknown names.
488 Renaming type variables is a pain. Because they now contain uniques,
489 it is necessary to pass in an association list which maps a parsed
490 tyvar to its @Name@ representation.
491 In some cases (type signatures of values),
492 it is even necessary to go over the type first
493 in order to get the set of tyvars used by it, make an assoc list,
494 and then go over it again to rename the tyvars!
495 However, we can also do some scoping checks at the same time.
498 rnTyClDecl (IfaceSig {tcdName = name, tcdType = ty, tcdIdInfo = id_infos, tcdLoc = loc})
500 lookupTopBndrRn name `thenM` \ name' ->
501 rnHsType doc_str ty `thenM` \ ty' ->
502 mappM rnIdInfo id_infos `thenM` \ id_infos' ->
503 returnM (IfaceSig {tcdName = name', tcdType = ty', tcdIdInfo = id_infos', tcdLoc = loc})
505 doc_str = text "In the interface signature for" <+> quotes (ppr name)
507 rnTyClDecl (ForeignType {tcdName = name, tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
509 lookupTopBndrRn name `thenM` \ name' ->
510 returnM (ForeignType {tcdName = name', tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
512 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
513 tcdTyVars = tyvars, tcdCons = condecls, tcdGeneric = want_generic,
514 tcdDerivs = derivs, tcdLoc = src_loc})
515 = addSrcLoc src_loc $
516 lookupTopBndrRn tycon `thenM` \ tycon' ->
517 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
518 rnContext data_doc context `thenM` \ context' ->
519 rn_derivs derivs `thenM` \ derivs' ->
520 checkDupOrQualNames data_doc con_names `thenM_`
522 rnConDecls tycon' condecls `thenM` \ condecls' ->
523 returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdName = tycon',
524 tcdTyVars = tyvars', tcdCons = condecls', tcdGeneric = want_generic,
525 tcdDerivs = derivs', tcdLoc = src_loc})
527 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
528 con_names = map conDeclName (visibleDataCons condecls)
530 rn_derivs Nothing = returnM Nothing
531 rn_derivs (Just ds) = rnContext data_doc ds `thenM` \ ds' -> returnM (Just ds')
533 rnTyClDecl (TySynonym {tcdName = name, tcdTyVars = tyvars, tcdSynRhs = ty, tcdLoc = src_loc})
534 = addSrcLoc src_loc $
535 lookupTopBndrRn name `thenM` \ name' ->
536 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
537 rnHsType syn_doc ty `thenM` \ ty' ->
538 returnM (TySynonym {tcdName = name', tcdTyVars = tyvars', tcdSynRhs = ty', tcdLoc = src_loc})
540 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
542 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
543 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
545 -- Used for both source and interface file decls
546 = addSrcLoc src_loc $
548 lookupTopBndrRn cname `thenM` \ cname' ->
550 -- Tyvars scope over superclass context and method signatures
551 bindTyVarsRn cls_doc tyvars $ \ tyvars' ->
553 -- Check the superclasses
554 rnContext cls_doc context `thenM` \ context' ->
556 -- Check the functional dependencies
557 rnFds cls_doc fds `thenM` \ fds' ->
559 -- Check the signatures
560 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
562 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
563 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
565 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenM_`
566 mappM (rnClassOp cname' fds') op_sigs `thenM` \ sigs' ->
567 renameSigs non_op_sigs `thenM` \ non_ops' ->
568 checkSigs okClsDclSig non_ops' `thenM_`
569 -- Typechecker is responsible for checking that we only
570 -- give default-method bindings for things in this class.
571 -- The renamer *could* check this for class decls, but can't
572 -- for instance decls.
574 returnM (ClassDecl { tcdCtxt = context', tcdName = cname', tcdTyVars = tyvars',
575 tcdFDs = fds', tcdSigs = non_ops' ++ sigs', tcdMeths = Nothing,
578 cls_doc = text "In the declaration for class" <+> ppr cname
579 sig_doc = text "In the signatures for class" <+> ppr cname
581 rnClassOp clas clas_fds sig@(ClassOpSig op dm_stuff ty locn)
583 lookupTopBndrRn op `thenM` \ op_name ->
585 -- Check the signature
586 rnHsSigType (quotes (ppr op)) ty `thenM` \ new_ty ->
588 -- Make the default-method name
591 -> -- Imported class that has a default method decl
592 lookupSysBndr dm_rdr_name `thenM` \ dm_name ->
593 returnM (DefMeth dm_name)
594 -- An imported class decl for a class decl that had an explicit default
595 -- method, mentions, rather than defines,
596 -- the default method, so we must arrange to pull it in
598 GenDefMeth -> returnM GenDefMeth
599 NoDefMeth -> returnM NoDefMeth
600 ) `thenM` \ dm_stuff' ->
602 returnM (ClassOpSig op_name dm_stuff' new_ty locn)
604 finishSourceTyClDecl :: RdrNameTyClDecl -> RenamedTyClDecl -> RnM (RenamedTyClDecl, FreeVars)
605 -- Used for source file decls only
606 -- Renames the default-bindings of a class decl
607 finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc}) -- Get mbinds from here
608 rn_cls_decl@(ClassDecl {tcdName = cls, tcdTyVars = tyvars}) -- Everything else is here
609 -- There are some default-method bindings (abeit possibly empty) so
610 -- this is a source-code class declaration
611 = -- The newLocals call is tiresome: given a generic class decl
614 -- op {| x+y |} (Inl a) = ...
615 -- op {| x+y |} (Inr b) = ...
616 -- op {| a*b |} (a*b) = ...
617 -- we want to name both "x" tyvars with the same unique, so that they are
618 -- easy to group together in the typechecker.
621 extendTyVarEnvForMethodBinds tyvars $
622 getLocalRdrEnv `thenM` \ name_env ->
624 meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
625 gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
626 not (tv `elemRdrEnv` name_env)]
628 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenM_`
629 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
630 rnMethodBinds cls gen_tyvars mbinds `thenM` \ (mbinds', meth_fvs) ->
631 returnM (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)
633 meth_doc = text "In the default-methods for class" <+> ppr (tcdName rn_cls_decl)
635 finishSourceTyClDecl _ tycl_decl@(TyData {tcdDerivs = derivings})
636 -- Derivings are returned here so that they don't form part of the tyClDeclFVs.
637 -- This is important, because tyClDeclFVs should contain only the
638 -- FVs that are `needed' by the interface file declaration, and
639 -- derivings do not appear in this. It also means that the tcGroups
640 -- are smaller, which turned out to be important for the usage inference. KSW 2002-02.
641 = returnM (tycl_decl,
642 maybe emptyFVs extractHsCtxtTyNames derivings)
644 finishSourceTyClDecl _ tycl_decl = returnM (tycl_decl, emptyFVs)
645 -- Not a class declaration
648 For the method bindings in class and instance decls, we extend the
649 type variable environment iff -fglasgow-exts
652 extendTyVarEnvForMethodBinds tyvars thing_inside
653 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
654 if opt_GlasgowExts then
655 extendTyVarEnvFVRn (map hsTyVarName tyvars) thing_inside
661 %*********************************************************
663 \subsection{Support code for type/data declarations}
665 %*********************************************************
668 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
669 conDeclName (ConDecl n _ _ _ l) = (n,l)
671 rnConDecls :: Name -> DataConDetails RdrNameConDecl -> RnM (DataConDetails RenamedConDecl)
672 rnConDecls tycon Unknown = returnM Unknown
673 rnConDecls tycon (HasCons n) = returnM (HasCons n)
674 rnConDecls tycon (DataCons condecls)
675 = -- Check that there's at least one condecl,
676 -- or else we're reading an interface file, or -fglasgow-exts
677 (if null condecls then
678 doptM Opt_GlasgowExts `thenM` \ glaExts ->
679 getModeRn `thenM` \ mode ->
680 checkErr (glaExts || isInterfaceMode mode)
681 (emptyConDeclsErr tycon)
685 mappM rnConDecl condecls `thenM` \ condecls' ->
686 returnM (DataCons condecls')
688 rnConDecl :: RdrNameConDecl -> RnM RenamedConDecl
689 rnConDecl (ConDecl name tvs cxt details locn)
691 checkConName name `thenM_`
692 lookupTopBndrRn name `thenM` \ new_name ->
694 bindTyVarsRn doc tvs $ \ new_tyvars ->
695 rnContext doc cxt `thenM` \ new_context ->
696 rnConDetails doc locn details `thenM` \ new_details ->
697 returnM (ConDecl new_name new_tyvars new_context new_details locn)
699 doc = text "In the definition of data constructor" <+> quotes (ppr name)
701 rnConDetails doc locn (PrefixCon tys)
702 = mappM (rnBangTy doc) tys `thenM` \ new_tys ->
703 returnM (PrefixCon new_tys)
705 rnConDetails doc locn (InfixCon ty1 ty2)
706 = rnBangTy doc ty1 `thenM` \ new_ty1 ->
707 rnBangTy doc ty2 `thenM` \ new_ty2 ->
708 returnM (InfixCon new_ty1 new_ty2)
710 rnConDetails doc locn (RecCon fields)
711 = checkDupOrQualNames doc field_names `thenM_`
712 mappM (rnField doc) fields `thenM` \ new_fields ->
713 returnM (RecCon new_fields)
715 field_names = [(fld, locn) | (fld, _) <- fields]
717 rnField doc (name, ty)
718 = lookupTopBndrRn name `thenM` \ new_name ->
719 rnBangTy doc ty `thenM` \ new_ty ->
720 returnM (new_name, new_ty)
722 rnBangTy doc (BangType s ty)
723 = rnHsType doc ty `thenM` \ new_ty ->
724 returnM (BangType s new_ty)
726 -- This data decl will parse OK
728 -- treating "a" as the constructor.
729 -- It is really hard to make the parser spot this malformation.
730 -- So the renamer has to check that the constructor is legal
732 -- We can get an operator as the constructor, even in the prefix form:
733 -- data T = :% Int Int
734 -- from interface files, which always print in prefix form
737 = checkErr (isRdrDataCon name) (badDataCon name)
741 %*********************************************************
743 \subsection{Support code to rename types}
745 %*********************************************************
748 rnFds :: SDoc -> [FunDep RdrName] -> RnM [FunDep Name]
754 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
755 rnHsTyVars doc tys2 `thenM` \ tys2' ->
756 returnM (tys1', tys2')
758 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
759 rnHsTyvar doc tyvar = lookupOccRn tyvar
762 %*********************************************************
766 %*********************************************************
769 rnIdInfo (HsWorker worker arity)
770 = lookupOccRn worker `thenM` \ worker' ->
771 returnM (HsWorker worker' arity)
773 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenM` \ expr' ->
774 returnM (HsUnfold inline expr')
775 rnIdInfo (HsStrictness str) = returnM (HsStrictness str)
776 rnIdInfo (HsArity arity) = returnM (HsArity arity)
777 rnIdInfo HsNoCafRefs = returnM HsNoCafRefs
780 @UfCore@ expressions.
783 rnCoreExpr (UfType ty)
784 = rnHsType (text "unfolding type") ty `thenM` \ ty' ->
788 = lookupOccRn v `thenM` \ v' ->
794 rnCoreExpr (UfLitLit l ty)
795 = rnHsType (text "litlit") ty `thenM` \ ty' ->
796 returnM (UfLitLit l ty')
798 rnCoreExpr (UfFCall cc ty)
799 = rnHsType (text "ccall") ty `thenM` \ ty' ->
800 returnM (UfFCall cc ty')
802 rnCoreExpr (UfTuple (HsTupCon boxity arity) args)
803 = mappM rnCoreExpr args `thenM` \ args' ->
804 returnM (UfTuple (HsTupCon boxity arity) args')
806 rnCoreExpr (UfApp fun arg)
807 = rnCoreExpr fun `thenM` \ fun' ->
808 rnCoreExpr arg `thenM` \ arg' ->
809 returnM (UfApp fun' arg')
811 rnCoreExpr (UfCase scrut bndr alts)
812 = rnCoreExpr scrut `thenM` \ scrut' ->
813 bindCoreLocalRn bndr $ \ bndr' ->
814 mappM rnCoreAlt alts `thenM` \ alts' ->
815 returnM (UfCase scrut' bndr' alts')
817 rnCoreExpr (UfNote note expr)
818 = rnNote note `thenM` \ note' ->
819 rnCoreExpr expr `thenM` \ expr' ->
820 returnM (UfNote note' expr')
822 rnCoreExpr (UfLam bndr body)
823 = rnCoreBndr bndr $ \ bndr' ->
824 rnCoreExpr body `thenM` \ body' ->
825 returnM (UfLam bndr' body')
827 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
828 = rnCoreExpr rhs `thenM` \ rhs' ->
829 rnCoreBndr bndr $ \ bndr' ->
830 rnCoreExpr body `thenM` \ body' ->
831 returnM (UfLet (UfNonRec bndr' rhs') body')
833 rnCoreExpr (UfLet (UfRec pairs) body)
834 = rnCoreBndrs bndrs $ \ bndrs' ->
835 mappM rnCoreExpr rhss `thenM` \ rhss' ->
836 rnCoreExpr body `thenM` \ body' ->
837 returnM (UfLet (UfRec (bndrs' `zip` rhss')) body')
839 (bndrs, rhss) = unzip pairs
843 rnCoreBndr (UfValBinder name ty) thing_inside
844 = rnHsType doc ty `thenM` \ ty' ->
845 bindCoreLocalRn name $ \ name' ->
846 thing_inside (UfValBinder name' ty')
848 doc = text "unfolding id"
850 rnCoreBndr (UfTyBinder name kind) thing_inside
851 = bindCoreLocalRn name $ \ name' ->
852 thing_inside (UfTyBinder name' kind)
854 rnCoreBndrs [] thing_inside = thing_inside []
855 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
856 rnCoreBndrs bs $ \ names' ->
857 thing_inside (name':names')
861 rnCoreAlt (con, bndrs, rhs)
862 = rnUfCon con `thenM` \ con' ->
863 bindCoreLocalsRn bndrs $ \ bndrs' ->
864 rnCoreExpr rhs `thenM` \ rhs' ->
865 returnM (con', bndrs', rhs')
868 = rnHsType (text "unfolding coerce") ty `thenM` \ ty' ->
869 returnM (UfCoerce ty')
871 rnNote (UfSCC cc) = returnM (UfSCC cc)
872 rnNote UfInlineCall = returnM UfInlineCall
873 rnNote UfInlineMe = returnM UfInlineMe
874 rnNote (UfCoreNote s) = returnM (UfCoreNote s)
879 rnUfCon (UfTupleAlt tup_con)
880 = returnM (UfTupleAlt tup_con)
882 rnUfCon (UfDataAlt con)
883 = lookupOccRn con `thenM` \ con' ->
884 returnM (UfDataAlt con')
886 rnUfCon (UfLitAlt lit)
887 = returnM (UfLitAlt lit)
889 rnUfCon (UfLitLitAlt lit ty)
890 = rnHsType (text "litlit") ty `thenM` \ ty' ->
891 returnM (UfLitLitAlt lit ty')
894 %*********************************************************
896 \subsection{Statistics}
898 %*********************************************************
901 rnStats :: [RenamedHsDecl] -- Imported decls
904 = doptM Opt_D_dump_rn_trace `thenM` \ dump_rn_trace ->
905 doptM Opt_D_dump_rn_stats `thenM` \ dump_rn_stats ->
906 doptM Opt_D_dump_rn `thenM` \ dump_rn ->
907 getEps `thenM` \ eps ->
909 ioToTcRn (dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
911 (getRnStats eps imp_decls)) `thenM_`
914 getRnStats :: ExternalPackageState -> [RenamedHsDecl] -> SDoc
915 getRnStats eps imported_decls
916 = hcat [text "Renamer stats: ", stats]
918 n_mods = length [() | _ <- moduleEnvElts (eps_PIT eps)]
919 -- This is really only right for a one-shot compile
921 (decls_map, n_decls_slurped) = eps_decls eps
923 n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
924 -- Data, newtype, and class decls are in the decls_fm
925 -- under multiple names; the tycon/class, and each
926 -- constructor/class op too.
927 -- The 'True' selects just the 'main' decl
930 (insts_left, n_insts_slurped) = eps_insts eps
931 n_insts_left = length (bagToList insts_left)
933 (rules_left, n_rules_slurped) = eps_rules eps
934 n_rules_left = length (bagToList rules_left)
937 [int n_mods <+> text "interfaces read",
938 hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
939 int (n_decls_slurped + n_decls_left), text "read"],
940 hsep [ int n_insts_slurped, text "instance decls imported, out of",
941 int (n_insts_slurped + n_insts_left), text "read"],
942 hsep [ int n_rules_slurped, text "rule decls imported, out of",
943 int (n_rules_slurped + n_rules_left), text "read"]
947 %*********************************************************
951 %*********************************************************
955 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
957 badRuleLhsErr name lhs (Just bad_e)
958 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
959 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
960 ptext SLIT("in left-hand side:") <+> ppr lhs])]
962 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
965 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
966 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
967 ptext SLIT("does not appear on left hand side")]
969 emptyConDeclsErr tycon
970 = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
971 nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]
974 = sep [quotes (ptext SLIT("with")),
975 ptext SLIT("is deprecated, use"),
976 quotes (ptext SLIT("let")),
977 ptext SLIT("instead")]
980 = hang (ptext SLIT("Implicit-parameter bindings illegal in 'mdo':")) 4