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
53 , unmarshalObjectName, marshalObjectName
54 , unmarshalStringName, marshalStringName
57 import List ( partition )
58 import Bag ( bagToList )
60 import SrcLoc ( SrcLoc )
61 import CmdLineOpts ( DynFlag(..) )
62 -- Warn of unused for-all'd tyvars
63 import Maybes ( maybeToBool, seqMaybe )
64 import Maybe ( maybe, catMaybes, isNothing )
67 @rnSourceDecl@ `renames' declarations.
68 It simultaneously performs dependency analysis and precedence parsing.
69 It also does the following error checks:
72 Checks that tyvars are used properly. This includes checking
73 for undefined tyvars, and tyvars in contexts that are ambiguous.
74 (Some of this checking has now been moved to module @TcMonoType@,
75 since we don't have functional dependency information at this point.)
77 Checks that all variable occurences are defined.
79 Checks the @(..)@ etc constraints in the export list.
84 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name, DefUses)
86 rnSrcDecls (HsGroup { hs_valds = MonoBind binds sigs _,
87 hs_tyclds = tycl_decls,
88 hs_instds = inst_decls,
90 hs_depds = deprec_decls,
91 hs_fords = foreign_decls,
92 hs_defds = default_decls,
93 hs_ruleds = rule_decls,
94 hs_coreds = core_decls })
96 = do { -- Deal with deprecations (returns only the extra deprecations)
97 deprecs <- rnSrcDeprecDecls deprec_decls ;
98 updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
101 -- Deal with top-level fixity decls
102 -- (returns the total new fixity env)
103 fix_env <- rnSrcFixityDecls fix_decls ;
104 updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
107 -- Rename other declarations
108 (rn_val_decls, bind_dus) <- rnTopMonoBinds binds sigs ;
110 -- You might think that we could build proper def/use information
111 -- for type and class declarations, but they can be involved
112 -- in mutual recursion across modules, and we only do the SCC
113 -- analysis for them in the type checker.
114 -- So we content ourselves with gathering uses only; that
115 -- means we'll only report a declaration as unused if it isn't
116 -- mentioned at all. Ah well.
117 (rn_tycl_decls, src_fvs1) <- mapFvRn rnSrcTyClDecl tycl_decls ;
118 (rn_inst_decls, src_fvs2) <- mapFvRn rnSrcInstDecl inst_decls ;
119 (rn_rule_decls, src_fvs3) <- mapFvRn rnHsRuleDecl rule_decls ;
120 (rn_foreign_decls, src_fvs4) <- mapFvRn rnHsForeignDecl foreign_decls ;
121 (rn_default_decls, src_fvs5) <- mapFvRn rnDefaultDecl default_decls ;
122 (rn_core_decls, src_fvs6) <- mapFvRn rnCoreDecl core_decls ;
125 rn_group = HsGroup { hs_valds = rn_val_decls,
126 hs_tyclds = rn_tycl_decls,
127 hs_instds = rn_inst_decls,
130 hs_fords = rn_foreign_decls,
131 hs_defds = rn_default_decls,
132 hs_ruleds = rn_rule_decls,
133 hs_coreds = rn_core_decls } ;
135 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3,
136 src_fvs4, src_fvs5, src_fvs6] ;
137 src_dus = bind_dus `plusDU` usesOnly other_fvs
140 tcg_env <- getGblEnv ;
141 return (tcg_env, rn_group, src_dus)
146 %*********************************************************
148 Source-code fixity declarations
150 %*********************************************************
153 rnSrcFixityDecls :: [RdrNameFixitySig] -> TcRn m FixityEnv
154 rnSrcFixityDecls fix_decls
155 = getGblEnv `thenM` \ gbl_env ->
156 foldlM rnFixityDecl (tcg_fix_env gbl_env)
157 fix_decls `thenM` \ fix_env ->
158 traceRn (text "fixity env" <+> ppr fix_env) `thenM_`
161 rnFixityDecl :: FixityEnv -> RdrNameFixitySig -> TcRn m FixityEnv
162 rnFixityDecl fix_env (FixitySig rdr_name fixity loc)
163 = -- GHC extension: look up both the tycon and data con
164 -- for con-like things
165 -- If neither are in scope, report an error; otherwise
166 -- add both to the fixity env
167 mappM lookupTopSrcBndr_maybe (dataTcOccs rdr_name) `thenM` \ maybe_ns ->
168 case catMaybes maybe_ns of
169 [] -> addSrcLoc loc $
170 addErr (unknownNameErr rdr_name) `thenM_`
172 ns -> foldlM add fix_env ns
175 = case lookupNameEnv fix_env name of
176 Just (FixitySig _ _ loc') -> addErr (dupFixityDecl rdr_name loc loc') `thenM_`
178 Nothing -> returnM (extendNameEnv fix_env name (FixitySig name fixity loc))
180 dupFixityDecl rdr_name loc1 loc2
181 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
182 ptext SLIT("at ") <+> ppr loc1,
183 ptext SLIT("and") <+> ppr loc2]
187 %*********************************************************
189 Source-code deprecations declarations
191 %*********************************************************
193 For deprecations, all we do is check that the names are in scope.
194 It's only imported deprecations, dealt with in RnIfaces, that we
195 gather them together.
198 rnSrcDeprecDecls :: [RdrNameDeprecation] -> TcRn m Deprecations
202 rnSrcDeprecDecls decls
203 = mappM rn_deprec decls `thenM` \ pairs ->
204 returnM (DeprecSome (mkNameEnv (catMaybes pairs)))
206 rn_deprec (Deprecation rdr_name txt loc)
208 lookupTopSrcBndr rdr_name `thenM` \ name ->
209 returnM (Just (name, (name,txt)))
211 checkModDeprec :: Maybe DeprecTxt -> Deprecations
212 -- Check for a module deprecation; done once at top level
213 checkModDeprec Nothing = NoDeprecs
214 checkModdeprec (Just txt) = DeprecAll txt
217 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
221 %*********************************************************
223 \subsection{Source code declarations}
225 %*********************************************************
228 rnSrcTyClDecl tycl_decl
229 = rnTyClDecl tycl_decl `thenM` \ new_decl ->
230 finishSourceTyClDecl tycl_decl new_decl `thenM` \ (new_decl', fvs) ->
231 returnM (new_decl', fvs `plusFV` tyClDeclFVs new_decl')
234 = rnInstDecl inst `thenM` \ new_inst ->
235 finishSourceInstDecl inst new_inst `thenM` \ (new_inst', fvs) ->
236 returnM (new_inst', fvs `plusFV` instDeclFVs new_inst')
238 rnDefaultDecl (DefaultDecl tys src_loc)
239 = addSrcLoc src_loc $
240 mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
241 returnM (DefaultDecl tys' src_loc, fvs)
243 doc_str = text "In a `default' declaration"
246 rnCoreDecl (CoreDecl name ty rhs loc)
248 lookupTopBndrRn name `thenM` \ name' ->
249 rnHsTypeFVs doc_str ty `thenM` \ (ty', ty_fvs) ->
250 rnCoreExpr rhs `thenM` \ rhs' ->
251 returnM (CoreDecl name' ty' rhs' loc,
252 ty_fvs `plusFV` ufExprFVs rhs')
254 doc_str = text "In the Core declaration for" <+> quotes (ppr name)
257 %*********************************************************
261 %*********************************************************
263 These chaps are here, rather than in TcBinds, so that there
264 is just one hi-boot file (for RnSource). rnSrcDecls is part
265 of the loop too, and it must be defined in this module.
268 rnBinds :: RdrNameHsBinds -> RnM (RenamedHsBinds, DefUses)
269 -- This version assumes that the binders are already in scope
270 -- It's used only in 'mdo'
271 rnBinds EmptyBinds = returnM (EmptyBinds, emptyDUs)
272 rnBinds (MonoBind bind sigs _) = rnMonoBinds NotTopLevel bind sigs
273 rnBinds b@(IPBinds bind _) = addErr (badIpBinds b) `thenM_`
274 returnM (EmptyBinds, emptyDUs)
276 rnBindsAndThen :: RdrNameHsBinds
277 -> (RenamedHsBinds -> RnM (result, FreeVars))
278 -> RnM (result, FreeVars)
279 -- This version (a) assumes that the binding vars are not already in scope
280 -- (b) removes the binders from the free vars of the thing inside
281 -- The parser doesn't produce ThenBinds
282 rnBindsAndThen EmptyBinds thing_inside = thing_inside EmptyBinds
283 rnBindsAndThen (MonoBind bind sigs _) thing_inside = rnMonoBindsAndThen bind sigs thing_inside
284 rnBindsAndThen (IPBinds binds is_with) thing_inside
285 = warnIf is_with withWarning `thenM_`
286 rnIPBinds binds `thenM` \ (binds',fv_binds) ->
287 thing_inside (IPBinds binds' is_with) `thenM` \ (thing, fvs_thing) ->
288 returnM (thing, fvs_thing `plusFV` fv_binds)
292 %************************************************************************
294 \subsubsection{@rnIPBinds@s: in implicit parameter bindings} *
296 %************************************************************************
299 rnIPBinds [] = returnM ([], emptyFVs)
300 rnIPBinds ((n, expr) : binds)
301 = newIPName n `thenM` \ name ->
302 rnExpr expr `thenM` \ (expr',fvExpr) ->
303 rnIPBinds binds `thenM` \ (binds',fvBinds) ->
304 returnM ((name, expr') : binds', fvExpr `plusFV` fvBinds)
309 %*********************************************************
311 \subsection{Foreign declarations}
313 %*********************************************************
316 rnHsForeignDecl (ForeignImport name ty spec isDeprec src_loc)
317 = addSrcLoc src_loc $
318 lookupTopBndrRn name `thenM` \ name' ->
319 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
320 returnM (ForeignImport name' ty' spec isDeprec src_loc,
321 fvs `plusFV` extras spec)
323 extras (CImport _ _ _ _ CWrapper)
324 = mkFVs [ newStablePtrName
331 , unmarshalObjectName
334 , unmarshalStringName
339 rnHsForeignDecl (ForeignExport name ty spec isDeprec src_loc)
340 = addSrcLoc src_loc $
341 lookupOccRn name `thenM` \ name' ->
342 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
343 returnM (ForeignExport name' ty' spec isDeprec src_loc,
344 mkFVs [name', bindIOName, returnIOName] `plusFV` fvs )
345 -- NB: a foreign export is an *occurrence site* for name, so
346 -- we add it to the free-variable list. It might, for example,
347 -- be imported from another module
349 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
353 %*********************************************************
355 \subsection{Instance declarations}
357 %*********************************************************
360 rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
361 -- Used for both source and interface file decls
362 = addSrcLoc src_loc $
363 rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
365 (case maybe_dfun_rdr_name of
366 Nothing -> returnM Nothing
367 Just dfun_rdr_name -> lookupGlobalOccRn dfun_rdr_name `thenM` \ dfun_name ->
368 returnM (Just dfun_name)
369 ) `thenM` \ maybe_dfun_name ->
371 -- The typechecker checks that all the bindings are for the right class.
372 returnM (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
374 -- Compare finishSourceTyClDecl
375 finishSourceInstDecl (InstDecl _ mbinds uprags _ _ )
376 (InstDecl inst_ty _ _ maybe_dfun_name src_loc)
377 -- Used for both source decls only
378 = ASSERT( not (maybeToBool maybe_dfun_name) ) -- Source decl!
380 meth_doc = text "In the bindings in an instance declaration"
381 meth_names = collectLocatedMonoBinders mbinds
382 (inst_tyvars, _, cls,_) = splitHsInstDeclTy inst_ty
383 -- (Slightly strangely) the forall-d tyvars scope over
384 -- the method bindings too
387 -- Rename the bindings
388 -- NB meth_names can be qualified!
389 checkDupNames meth_doc meth_names `thenM_`
390 extendTyVarEnvForMethodBinds inst_tyvars (
391 rnMethodBinds cls [] mbinds
392 ) `thenM` \ (mbinds', meth_fvs) ->
394 binders = collectMonoBinders mbinds'
396 -- Rename the prags and signatures.
397 -- Note that the type variables are not in scope here,
398 -- so that instance Eq a => Eq (T a) where
399 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
402 -- But the (unqualified) method names are in scope
403 bindLocalNames binders (renameSigs uprags) `thenM` \ uprags' ->
404 checkSigs (okInstDclSig (mkNameSet binders)) uprags' `thenM_`
406 returnM (InstDecl inst_ty mbinds' uprags' maybe_dfun_name src_loc,
407 meth_fvs `plusFV` hsSigsFVs uprags')
410 %*********************************************************
414 %*********************************************************
417 rnIfaceRuleDecl (IfaceRule rule_name act vars fn args rhs src_loc)
418 = addSrcLoc src_loc $
419 lookupOccRn fn `thenM` \ fn' ->
420 rnCoreBndrs vars $ \ vars' ->
421 mappM rnCoreExpr args `thenM` \ args' ->
422 rnCoreExpr rhs `thenM` \ rhs' ->
423 returnM (IfaceRule rule_name act vars' fn' args' rhs' src_loc)
425 rnIfaceRuleDecl (IfaceRuleOut fn rule) -- Builtin rules come this way
426 = lookupOccRn fn `thenM` \ fn' ->
427 returnM (IfaceRuleOut fn' rule)
429 rnHsRuleDecl (HsRule rule_name act vars lhs rhs src_loc)
430 = addSrcLoc src_loc $
431 bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
433 bindLocalsFV doc (map get_var vars) $ \ ids ->
434 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
436 rnExpr lhs `thenM` \ (lhs', fv_lhs) ->
437 rnExpr rhs `thenM` \ (rhs', fv_rhs) ->
439 mb_bad = validRuleLhs ids lhs'
441 checkErr (isNothing mb_bad)
442 (badRuleLhsErr rule_name lhs' mb_bad) `thenM_`
444 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
446 mappM (addErr . badRuleVar rule_name) bad_vars `thenM_`
447 returnM (HsRule rule_name act vars' lhs' rhs' src_loc,
448 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
450 doc = text "In the transformation rule" <+> ftext rule_name
452 get_var (RuleBndr v) = v
453 get_var (RuleBndrSig v _) = v
455 rn_var (RuleBndr v, id) = returnM (RuleBndr id, emptyFVs)
456 rn_var (RuleBndrSig v t, id) = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
457 returnM (RuleBndrSig id t', fvs)
460 Check the shape of a transformation rule LHS. Currently
461 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
462 not one of the @forall@'d variables. We also restrict the form of the LHS so
463 that it may be plausibly matched. Basically you only get to write ordinary
464 applications. (E.g. a case expression is not allowed: too elaborate.)
466 NB: if you add new cases here, make sure you add new ones to TcRule.ruleLhsTvs
469 validRuleLhs :: [Name] -> RenamedHsExpr -> Maybe RenamedHsExpr
471 -- Just e => Not ok, and e is the offending expression
472 validRuleLhs foralls lhs
475 check (OpApp e1 op _ e2) = check op `seqMaybe` check_e e1 `seqMaybe` check_e e2
476 check (HsApp e1 e2) = check e1 `seqMaybe` check_e e2
477 check (HsVar v) | v `notElem` foralls = Nothing
478 check other = Just other -- Failure
480 check_e (HsVar v) = Nothing
481 check_e (HsPar e) = check_e e
482 check_e (HsLit e) = Nothing
483 check_e (HsOverLit e) = Nothing
485 check_e (OpApp e1 op _ e2) = check_e e1 `seqMaybe` check_e op `seqMaybe` check_e e2
486 check_e (HsApp e1 e2) = check_e e1 `seqMaybe` check_e e2
487 check_e (NegApp e _) = check_e e
488 check_e (ExplicitList _ es) = check_es es
489 check_e (ExplicitTuple es _) = check_es es
490 check_e other = Just other -- Fails
492 check_es es = foldr (seqMaybe . check_e) Nothing es
496 %*********************************************************
498 \subsection{Type, class and iface sig declarations}
500 %*********************************************************
502 @rnTyDecl@ uses the `global name function' to create a new type
503 declaration in which local names have been replaced by their original
504 names, reporting any unknown names.
506 Renaming type variables is a pain. Because they now contain uniques,
507 it is necessary to pass in an association list which maps a parsed
508 tyvar to its @Name@ representation.
509 In some cases (type signatures of values),
510 it is even necessary to go over the type first
511 in order to get the set of tyvars used by it, make an assoc list,
512 and then go over it again to rename the tyvars!
513 However, we can also do some scoping checks at the same time.
516 rnTyClDecl (IfaceSig {tcdName = name, tcdType = ty, tcdIdInfo = id_infos, tcdLoc = loc})
518 lookupTopBndrRn name `thenM` \ name' ->
519 rnHsType doc_str ty `thenM` \ ty' ->
520 mappM rnIdInfo id_infos `thenM` \ id_infos' ->
521 returnM (IfaceSig {tcdName = name', tcdType = ty', tcdIdInfo = id_infos', tcdLoc = loc})
523 doc_str = text "In the interface signature for" <+> quotes (ppr name)
525 rnTyClDecl (ForeignType {tcdName = name, tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
527 lookupTopBndrRn name `thenM` \ name' ->
528 returnM (ForeignType {tcdName = name', tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
530 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
531 tcdTyVars = tyvars, tcdCons = condecls, tcdGeneric = want_generic,
532 tcdDerivs = derivs, tcdLoc = src_loc})
533 = addSrcLoc src_loc $
534 lookupTopBndrRn tycon `thenM` \ tycon' ->
535 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
536 rnContext data_doc context `thenM` \ context' ->
537 rn_derivs derivs `thenM` \ derivs' ->
538 checkDupOrQualNames data_doc con_names `thenM_`
540 rnConDecls tycon' condecls `thenM` \ condecls' ->
541 returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdName = tycon',
542 tcdTyVars = tyvars', tcdCons = condecls', tcdGeneric = want_generic,
543 tcdDerivs = derivs', tcdLoc = src_loc})
545 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
546 con_names = map conDeclName (visibleDataCons condecls)
548 rn_derivs Nothing = returnM Nothing
549 rn_derivs (Just ds) = rnContext data_doc ds `thenM` \ ds' -> returnM (Just ds')
551 rnTyClDecl (TySynonym {tcdName = name, tcdTyVars = tyvars, tcdSynRhs = ty, tcdLoc = src_loc})
552 = addSrcLoc src_loc $
553 lookupTopBndrRn name `thenM` \ name' ->
554 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
555 rnHsType syn_doc ty `thenM` \ ty' ->
556 returnM (TySynonym {tcdName = name', tcdTyVars = tyvars', tcdSynRhs = ty', tcdLoc = src_loc})
558 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
560 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
561 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
563 -- Used for both source and interface file decls
564 = addSrcLoc src_loc $
566 lookupTopBndrRn cname `thenM` \ cname' ->
568 -- Tyvars scope over superclass context and method signatures
569 bindTyVarsRn cls_doc tyvars $ \ tyvars' ->
571 -- Check the superclasses
572 rnContext cls_doc context `thenM` \ context' ->
574 -- Check the functional dependencies
575 rnFds cls_doc fds `thenM` \ fds' ->
577 -- Check the signatures
578 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
580 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
581 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
583 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenM_`
584 mappM (rnClassOp cname' fds') op_sigs `thenM` \ sigs' ->
585 renameSigs non_op_sigs `thenM` \ non_ops' ->
586 checkSigs okClsDclSig non_ops' `thenM_`
587 -- Typechecker is responsible for checking that we only
588 -- give default-method bindings for things in this class.
589 -- The renamer *could* check this for class decls, but can't
590 -- for instance decls.
592 returnM (ClassDecl { tcdCtxt = context', tcdName = cname', tcdTyVars = tyvars',
593 tcdFDs = fds', tcdSigs = non_ops' ++ sigs', tcdMeths = Nothing,
596 cls_doc = text "In the declaration for class" <+> ppr cname
597 sig_doc = text "In the signatures for class" <+> ppr cname
599 rnClassOp clas clas_fds sig@(ClassOpSig op dm_stuff ty locn)
601 lookupTopBndrRn op `thenM` \ op_name ->
603 -- Check the signature
604 rnHsSigType (quotes (ppr op)) ty `thenM` \ new_ty ->
606 -- Make the default-method name
609 -> -- Imported class that has a default method decl
610 lookupSysBndr dm_rdr_name `thenM` \ dm_name ->
611 returnM (DefMeth dm_name)
612 -- An imported class decl for a class decl that had an explicit default
613 -- method, mentions, rather than defines,
614 -- the default method, so we must arrange to pull it in
616 GenDefMeth -> returnM GenDefMeth
617 NoDefMeth -> returnM NoDefMeth
618 ) `thenM` \ dm_stuff' ->
620 returnM (ClassOpSig op_name dm_stuff' new_ty locn)
622 finishSourceTyClDecl :: RdrNameTyClDecl -> RenamedTyClDecl -> RnM (RenamedTyClDecl, FreeVars)
623 -- Used for source file decls only
624 -- Renames the default-bindings of a class decl
625 finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc}) -- Get mbinds from here
626 rn_cls_decl@(ClassDecl {tcdName = cls, tcdTyVars = tyvars}) -- Everything else is here
627 -- There are some default-method bindings (abeit possibly empty) so
628 -- this is a source-code class declaration
629 = -- The newLocals call is tiresome: given a generic class decl
632 -- op {| x+y |} (Inl a) = ...
633 -- op {| x+y |} (Inr b) = ...
634 -- op {| a*b |} (a*b) = ...
635 -- we want to name both "x" tyvars with the same unique, so that they are
636 -- easy to group together in the typechecker.
639 extendTyVarEnvForMethodBinds tyvars $
640 getLocalRdrEnv `thenM` \ name_env ->
642 meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
643 gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
644 not (tv `elemRdrEnv` name_env)]
646 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenM_`
647 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
648 rnMethodBinds cls gen_tyvars mbinds `thenM` \ (mbinds', meth_fvs) ->
649 returnM (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)
651 meth_doc = text "In the default-methods for class" <+> ppr (tcdName rn_cls_decl)
653 finishSourceTyClDecl _ tycl_decl@(TyData {tcdDerivs = derivings})
654 -- Derivings are returned here so that they don't form part of the tyClDeclFVs.
655 -- This is important, because tyClDeclFVs should contain only the
656 -- FVs that are `needed' by the interface file declaration, and
657 -- derivings do not appear in this. It also means that the tcGroups
658 -- are smaller, which turned out to be important for the usage inference. KSW 2002-02.
659 = returnM (tycl_decl,
660 maybe emptyFVs extractHsCtxtTyNames derivings)
662 finishSourceTyClDecl _ tycl_decl = returnM (tycl_decl, emptyFVs)
663 -- Not a class declaration
666 For the method bindings in class and instance decls, we extend the
667 type variable environment iff -fglasgow-exts
670 extendTyVarEnvForMethodBinds tyvars thing_inside
671 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
672 if opt_GlasgowExts then
673 extendTyVarEnvFVRn (map hsTyVarName tyvars) thing_inside
679 %*********************************************************
681 \subsection{Support code for type/data declarations}
683 %*********************************************************
686 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
687 conDeclName (ConDecl n _ _ _ l) = (n,l)
689 rnConDecls :: Name -> DataConDetails RdrNameConDecl -> RnM (DataConDetails RenamedConDecl)
690 rnConDecls tycon Unknown = returnM Unknown
691 rnConDecls tycon (HasCons n) = returnM (HasCons n)
692 rnConDecls tycon (DataCons condecls)
693 = -- Check that there's at least one condecl,
694 -- or else we're reading an interface file, or -fglasgow-exts
695 (if null condecls then
696 doptM Opt_GlasgowExts `thenM` \ glaExts ->
697 getModeRn `thenM` \ mode ->
698 checkErr (glaExts || isInterfaceMode mode)
699 (emptyConDeclsErr tycon)
703 mappM rnConDecl condecls `thenM` \ condecls' ->
704 returnM (DataCons condecls')
706 rnConDecl :: RdrNameConDecl -> RnM RenamedConDecl
707 rnConDecl (ConDecl name tvs cxt details locn)
709 checkConName name `thenM_`
710 lookupTopBndrRn name `thenM` \ new_name ->
712 bindTyVarsRn doc tvs $ \ new_tyvars ->
713 rnContext doc cxt `thenM` \ new_context ->
714 rnConDetails doc locn details `thenM` \ new_details ->
715 returnM (ConDecl new_name new_tyvars new_context new_details locn)
717 doc = text "In the definition of data constructor" <+> quotes (ppr name)
719 rnConDetails doc locn (PrefixCon tys)
720 = mappM (rnBangTy doc) tys `thenM` \ new_tys ->
721 returnM (PrefixCon new_tys)
723 rnConDetails doc locn (InfixCon ty1 ty2)
724 = rnBangTy doc ty1 `thenM` \ new_ty1 ->
725 rnBangTy doc ty2 `thenM` \ new_ty2 ->
726 returnM (InfixCon new_ty1 new_ty2)
728 rnConDetails doc locn (RecCon fields)
729 = checkDupOrQualNames doc field_names `thenM_`
730 mappM (rnField doc) fields `thenM` \ new_fields ->
731 returnM (RecCon new_fields)
733 field_names = [(fld, locn) | (fld, _) <- fields]
735 rnField doc (name, ty)
736 = lookupTopBndrRn name `thenM` \ new_name ->
737 rnBangTy doc ty `thenM` \ new_ty ->
738 returnM (new_name, new_ty)
740 rnBangTy doc (BangType s ty)
741 = rnHsType doc ty `thenM` \ new_ty ->
742 returnM (BangType s new_ty)
744 -- This data decl will parse OK
746 -- treating "a" as the constructor.
747 -- It is really hard to make the parser spot this malformation.
748 -- So the renamer has to check that the constructor is legal
750 -- We can get an operator as the constructor, even in the prefix form:
751 -- data T = :% Int Int
752 -- from interface files, which always print in prefix form
755 = checkErr (isRdrDataCon name) (badDataCon name)
759 %*********************************************************
761 \subsection{Support code to rename types}
763 %*********************************************************
766 rnFds :: SDoc -> [FunDep RdrName] -> RnM [FunDep Name]
772 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
773 rnHsTyVars doc tys2 `thenM` \ tys2' ->
774 returnM (tys1', tys2')
776 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
777 rnHsTyvar doc tyvar = lookupOccRn tyvar
780 %*********************************************************
784 %*********************************************************
787 rnIdInfo (HsWorker worker arity)
788 = lookupOccRn worker `thenM` \ worker' ->
789 returnM (HsWorker worker' arity)
791 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenM` \ expr' ->
792 returnM (HsUnfold inline expr')
793 rnIdInfo (HsStrictness str) = returnM (HsStrictness str)
794 rnIdInfo (HsArity arity) = returnM (HsArity arity)
795 rnIdInfo HsNoCafRefs = returnM HsNoCafRefs
798 @UfCore@ expressions.
801 rnCoreExpr (UfType ty)
802 = rnHsType (text "unfolding type") ty `thenM` \ ty' ->
806 = lookupOccRn v `thenM` \ v' ->
812 rnCoreExpr (UfLitLit l ty)
813 = rnHsType (text "litlit") ty `thenM` \ ty' ->
814 returnM (UfLitLit l ty')
816 rnCoreExpr (UfFCall cc ty)
817 = rnHsType (text "ccall") ty `thenM` \ ty' ->
818 returnM (UfFCall cc ty')
820 rnCoreExpr (UfTuple (HsTupCon boxity arity) args)
821 = mappM rnCoreExpr args `thenM` \ args' ->
822 returnM (UfTuple (HsTupCon boxity arity) args')
824 rnCoreExpr (UfApp fun arg)
825 = rnCoreExpr fun `thenM` \ fun' ->
826 rnCoreExpr arg `thenM` \ arg' ->
827 returnM (UfApp fun' arg')
829 rnCoreExpr (UfCase scrut bndr alts)
830 = rnCoreExpr scrut `thenM` \ scrut' ->
831 bindCoreLocalRn bndr $ \ bndr' ->
832 mappM rnCoreAlt alts `thenM` \ alts' ->
833 returnM (UfCase scrut' bndr' alts')
835 rnCoreExpr (UfNote note expr)
836 = rnNote note `thenM` \ note' ->
837 rnCoreExpr expr `thenM` \ expr' ->
838 returnM (UfNote note' expr')
840 rnCoreExpr (UfLam bndr body)
841 = rnCoreBndr bndr $ \ bndr' ->
842 rnCoreExpr body `thenM` \ body' ->
843 returnM (UfLam bndr' body')
845 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
846 = rnCoreExpr rhs `thenM` \ rhs' ->
847 rnCoreBndr bndr $ \ bndr' ->
848 rnCoreExpr body `thenM` \ body' ->
849 returnM (UfLet (UfNonRec bndr' rhs') body')
851 rnCoreExpr (UfLet (UfRec pairs) body)
852 = rnCoreBndrs bndrs $ \ bndrs' ->
853 mappM rnCoreExpr rhss `thenM` \ rhss' ->
854 rnCoreExpr body `thenM` \ body' ->
855 returnM (UfLet (UfRec (bndrs' `zip` rhss')) body')
857 (bndrs, rhss) = unzip pairs
861 rnCoreBndr (UfValBinder name ty) thing_inside
862 = rnHsType doc ty `thenM` \ ty' ->
863 bindCoreLocalRn name $ \ name' ->
864 thing_inside (UfValBinder name' ty')
866 doc = text "unfolding id"
868 rnCoreBndr (UfTyBinder name kind) thing_inside
869 = bindCoreLocalRn name $ \ name' ->
870 thing_inside (UfTyBinder name' kind)
872 rnCoreBndrs [] thing_inside = thing_inside []
873 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
874 rnCoreBndrs bs $ \ names' ->
875 thing_inside (name':names')
879 rnCoreAlt (con, bndrs, rhs)
880 = rnUfCon con `thenM` \ con' ->
881 bindCoreLocalsRn bndrs $ \ bndrs' ->
882 rnCoreExpr rhs `thenM` \ rhs' ->
883 returnM (con', bndrs', rhs')
886 = rnHsType (text "unfolding coerce") ty `thenM` \ ty' ->
887 returnM (UfCoerce ty')
889 rnNote (UfSCC cc) = returnM (UfSCC cc)
890 rnNote UfInlineCall = returnM UfInlineCall
891 rnNote UfInlineMe = returnM UfInlineMe
892 rnNote (UfCoreNote s) = returnM (UfCoreNote s)
897 rnUfCon (UfTupleAlt tup_con)
898 = returnM (UfTupleAlt tup_con)
900 rnUfCon (UfDataAlt con)
901 = lookupOccRn con `thenM` \ con' ->
902 returnM (UfDataAlt con')
904 rnUfCon (UfLitAlt lit)
905 = returnM (UfLitAlt lit)
907 rnUfCon (UfLitLitAlt lit ty)
908 = rnHsType (text "litlit") ty `thenM` \ ty' ->
909 returnM (UfLitLitAlt lit ty')
912 %*********************************************************
914 \subsection{Statistics}
916 %*********************************************************
919 rnStats :: [RenamedHsDecl] -- Imported decls
922 = doptM Opt_D_dump_rn_trace `thenM` \ dump_rn_trace ->
923 doptM Opt_D_dump_rn_stats `thenM` \ dump_rn_stats ->
924 doptM Opt_D_dump_rn `thenM` \ dump_rn ->
925 getEps `thenM` \ eps ->
927 ioToTcRn (dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
929 (getRnStats eps imp_decls)) `thenM_`
932 getRnStats :: ExternalPackageState -> [RenamedHsDecl] -> SDoc
933 getRnStats eps imported_decls
934 = hcat [text "Renamer stats: ", stats]
936 n_mods = length [() | _ <- moduleEnvElts (eps_PIT eps)]
937 -- This is really only right for a one-shot compile
939 (decls_map, n_decls_slurped) = eps_decls eps
941 n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
942 -- Data, newtype, and class decls are in the decls_fm
943 -- under multiple names; the tycon/class, and each
944 -- constructor/class op too.
945 -- The 'True' selects just the 'main' decl
948 (insts_left, n_insts_slurped) = eps_insts eps
949 n_insts_left = length (bagToList insts_left)
951 (rules_left, n_rules_slurped) = eps_rules eps
952 n_rules_left = length (bagToList rules_left)
955 [int n_mods <+> text "interfaces read",
956 hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
957 int (n_decls_slurped + n_decls_left), text "read"],
958 hsep [ int n_insts_slurped, text "instance decls imported, out of",
959 int (n_insts_slurped + n_insts_left), text "read"],
960 hsep [ int n_rules_slurped, text "rule decls imported, out of",
961 int (n_rules_slurped + n_rules_left), text "read"]
965 %*********************************************************
969 %*********************************************************
973 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
975 badRuleLhsErr name lhs (Just bad_e)
976 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
977 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
978 ptext SLIT("in left-hand side:") <+> ppr lhs])]
980 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
983 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
984 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
985 ptext SLIT("does not appear on left hand side")]
987 emptyConDeclsErr tycon
988 = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
989 nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]
992 = sep [quotes (ptext SLIT("with")),
993 ptext SLIT("is deprecated, use"),
994 quotes (ptext SLIT("let")),
995 ptext SLIT("instead")]
998 = hang (ptext SLIT("Implicit-parameter bindings illegal in 'mdo':")) 4