2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
8 rnSrcDecls, rnExtCoreDecls, checkModDeprec,
9 rnTyClDecl, rnIfaceRuleDecl, rnInstDecl,
13 #include "HsVersions.h"
17 import RdrName ( RdrName, isRdrDataCon, elemRdrEnv )
18 import RdrHsSyn ( RdrNameConDecl, RdrNameTyClDecl, RdrNameHsDecl,
19 RdrNameDeprecation, RdrNameFixitySig,
21 extractGenericPatTyVars
26 import RnNames ( importsFromLocalDecls )
27 import RnTypes ( rnHsType, rnHsSigType, rnHsTypeFVs, rnContext )
29 import RnBinds ( rnTopMonoBinds, rnMonoBinds, rnMethodBinds,
30 renameSigs, renameSigsFVs )
31 import RnEnv ( lookupTopBndrRn, lookupOccRn, lookupSysBndr,
32 newLocalsRn, lookupGlobalOccRn,
33 bindLocalsFVRn, bindPatSigTyVars,
34 bindTyVarsRn, extendTyVarEnvFVRn,
35 bindCoreLocalRn, bindCoreLocalsRn, bindLocalNames,
36 checkDupOrQualNames, checkDupNames, mapFvRn,
37 lookupTopSrcBndr_maybe, lookupTopSrcBndr,
38 dataTcOccs, unknownNameErr,
43 import BasicTypes ( FixitySig(..) )
44 import HscTypes ( ExternalPackageState(..), FixityEnv,
45 Deprecations(..), plusDeprecs )
46 import Module ( moduleEnvElts )
47 import Class ( FunDep, DefMeth (..) )
48 import TyCon ( DataConDetails(..), visibleDataCons )
52 import ErrUtils ( dumpIfSet )
53 import PrelNames ( newStablePtrName, bindIOName, returnIOName )
54 import List ( partition )
55 import Bag ( bagToList )
57 import SrcLoc ( SrcLoc )
58 import CmdLineOpts ( DynFlag(..) )
59 -- Warn of unused for-all'd tyvars
60 import Maybes ( maybeToBool, seqMaybe )
61 import Maybe ( maybe, catMaybes, isNothing )
64 @rnSourceDecl@ `renames' declarations.
65 It simultaneously performs dependency analysis and precedence parsing.
66 It also does the following error checks:
69 Checks that tyvars are used properly. This includes checking
70 for undefined tyvars, and tyvars in contexts that are ambiguous.
71 (Some of this checking has now been moved to module @TcMonoType@,
72 since we don't have functional dependency information at this point.)
74 Checks that all variable occurences are defined.
76 Checks the @(..)@ etc constraints in the export list.
81 rnSrcDecls :: [RdrNameHsDecl] -> RnM (TcGblEnv, [RenamedHsDecl], FreeVars)
84 = do { (rdr_env, imports) <- importsFromLocalDecls decls ;
85 updGblEnv (\gbl -> gbl { tcg_rdr_env = rdr_env `plusGlobalRdrEnv`
87 tcg_imports = imports `plusImportAvails`
91 -- Deal with deprecations (returns only the extra deprecations)
92 deprecs <- rnSrcDeprecDecls [d | DeprecD d <- decls] ;
93 updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
96 -- Deal with top-level fixity decls
97 -- (returns the total new fixity env)
98 fix_env <- rnSrcFixityDecls decls ;
99 updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
102 failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
104 -- Rename remaining declarations
105 (rn_src_decls, src_fvs) <- rn_src_decls decls ;
107 tcg_env <- getGblEnv ;
108 return (tcg_env, rn_src_decls, src_fvs)
111 rnExtCoreDecls :: [RdrNameHsDecl] -> RnM ([RenamedHsDecl], FreeVars)
112 rnExtCoreDecls decls = rn_src_decls decls
114 rn_src_decls decls -- Declarartions get reversed, but no matter
115 = go emptyFVs [] decls
117 -- Fixity and deprecations have been dealt with already; ignore them
118 go fvs ds' [] = returnM (ds', fvs)
119 go fvs ds' (FixD _:ds) = go fvs ds' ds
120 go fvs ds' (DeprecD _:ds) = go fvs ds' ds
121 go fvs ds' (d:ds) = rnSrcDecl d `thenM` \(d', fvs') ->
122 go (fvs `plusFV` fvs') (d':ds') ds
126 %*********************************************************
128 Source-code fixity declarations
130 %*********************************************************
133 rnSrcFixityDecls :: [RdrNameHsDecl] -> TcRn m FixityEnv
134 rnSrcFixityDecls decls
135 = getGblEnv `thenM` \ gbl_env ->
136 foldlM rnFixityDecl (tcg_fix_env gbl_env)
137 fix_decls `thenM` \ fix_env ->
138 traceRn (text "fixity env" <+> ppr fix_env) `thenM_`
141 fix_decls = foldr get_fix_sigs [] decls
143 -- Get fixities from top level decls, and from class decl sigs too
144 get_fix_sigs (FixD fix) acc = fix:acc
145 get_fix_sigs (TyClD (ClassDecl { tcdSigs = sigs})) acc
146 = [sig | FixSig sig <- sigs] ++ acc
147 get_fix_sigs other_decl acc = acc
149 rnFixityDecl :: FixityEnv -> RdrNameFixitySig -> TcRn m FixityEnv
150 rnFixityDecl fix_env (FixitySig rdr_name fixity loc)
151 = -- GHC extension: look up both the tycon and data con
152 -- for con-like things
153 -- If neither are in scope, report an error; otherwise
154 -- add both to the fixity env
155 mappM lookupTopSrcBndr_maybe (dataTcOccs rdr_name) `thenM` \ maybe_ns ->
156 case catMaybes maybe_ns of
157 [] -> addSrcLoc loc $
158 addErr (unknownNameErr rdr_name) `thenM_`
160 ns -> foldlM add fix_env ns
163 = case lookupNameEnv fix_env name of
164 Just (FixitySig _ _ loc') -> addErr (dupFixityDecl rdr_name loc loc') `thenM_`
166 Nothing -> returnM (extendNameEnv fix_env name (FixitySig name fixity loc))
168 dupFixityDecl rdr_name loc1 loc2
169 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
170 ptext SLIT("at ") <+> ppr loc1,
171 ptext SLIT("and") <+> ppr loc2]
175 %*********************************************************
177 Source-code deprecations declarations
179 %*********************************************************
181 For deprecations, all we do is check that the names are in scope.
182 It's only imported deprecations, dealt with in RnIfaces, that we
183 gather them together.
186 rnSrcDeprecDecls :: [RdrNameDeprecation] -> TcRn m Deprecations
190 rnSrcDeprecDecls decls
191 = mappM rn_deprec decls `thenM` \ pairs ->
192 returnM (DeprecSome (mkNameEnv (catMaybes pairs)))
194 rn_deprec (Deprecation rdr_name txt loc)
196 lookupTopSrcBndr rdr_name `thenM` \ name ->
197 returnM (Just (name, (name,txt)))
199 checkModDeprec :: Maybe DeprecTxt -> Deprecations
200 -- Check for a module deprecation; done once at top level
201 checkModDeprec Nothing = NoDeprecs
202 checkModdeprec (Just txt) = DeprecAll txt
205 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
209 %*********************************************************
211 \subsection{Source code declarations}
213 %*********************************************************
216 rnSrcDecl :: RdrNameHsDecl -> RnM (RenamedHsDecl, FreeVars)
218 rnSrcDecl (ValD binds) = rnTopBinds binds `thenM` \ (new_binds, fvs) ->
219 returnM (ValD new_binds, fvs)
221 rnSrcDecl (TyClD tycl_decl)
222 = rnTyClDecl tycl_decl `thenM` \ new_decl ->
223 finishSourceTyClDecl tycl_decl new_decl `thenM` \ (new_decl', fvs) ->
224 returnM (TyClD new_decl', fvs `plusFV` tyClDeclFVs new_decl')
226 rnSrcDecl (InstD inst)
227 = rnInstDecl inst `thenM` \ new_inst ->
228 finishSourceInstDecl inst new_inst `thenM` \ (new_inst', fvs) ->
229 returnM (InstD new_inst', fvs `plusFV` instDeclFVs new_inst')
231 rnSrcDecl (RuleD rule)
232 = rnHsRuleDecl rule `thenM` \ (new_rule, fvs) ->
233 returnM (RuleD new_rule, fvs)
235 rnSrcDecl (ForD ford)
236 = rnHsForeignDecl ford `thenM` \ (new_ford, fvs) ->
237 returnM (ForD new_ford, fvs)
239 rnSrcDecl (DefD (DefaultDecl tys src_loc))
240 = addSrcLoc src_loc $
241 mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
242 returnM (DefD (DefaultDecl tys' src_loc), fvs)
244 doc_str = text "In a `default' declaration"
247 rnSrcDecl (CoreD (CoreDecl name ty rhs loc))
249 lookupTopBndrRn name `thenM` \ name' ->
250 rnHsTypeFVs doc_str ty `thenM` \ (ty', ty_fvs) ->
251 rnCoreExpr rhs `thenM` \ rhs' ->
252 returnM (CoreD (CoreDecl name' ty' rhs' loc),
253 ty_fvs `plusFV` ufExprFVs rhs')
255 doc_str = text "In the Core declaration for" <+> quotes (ppr name)
258 %*********************************************************
262 %*********************************************************
264 These chaps are here, rather than in TcBinds, so that there
265 is just one hi-boot file (for RnSource). rnSrcDecls is part
266 of the loop too, and it must be defined in this module.
269 rnTopBinds :: RdrNameHsBinds -> RnM (RenamedHsBinds, FreeVars)
270 rnTopBinds EmptyBinds = returnM (EmptyBinds, emptyFVs)
271 rnTopBinds (MonoBind bind sigs _) = rnTopMonoBinds bind sigs
272 -- The parser doesn't produce other forms
274 rnBinds :: RdrNameHsBinds
275 -> (RenamedHsBinds -> RnM (result, FreeVars))
276 -> RnM (result, FreeVars)
277 rnBinds EmptyBinds thing_inside = thing_inside EmptyBinds
278 rnBinds (MonoBind bind sigs _) thing_inside = rnMonoBinds bind sigs thing_inside
279 -- the parser doesn't produce other forms
283 %*********************************************************
285 \subsection{Foreign declarations}
287 %*********************************************************
290 rnHsForeignDecl (ForeignImport name ty spec isDeprec src_loc)
291 = addSrcLoc src_loc $
292 lookupTopBndrRn name `thenM` \ name' ->
293 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
294 returnM (ForeignImport name' ty' spec isDeprec src_loc,
295 fvs `plusFV` extras spec)
297 extras (CImport _ _ _ _ CWrapper) = mkFVs [newStablePtrName,
298 bindIOName, returnIOName]
301 rnHsForeignDecl (ForeignExport name ty spec isDeprec src_loc)
302 = addSrcLoc src_loc $
303 lookupOccRn name `thenM` \ name' ->
304 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
305 returnM (ForeignExport name' ty' spec isDeprec src_loc,
306 mkFVs [name', bindIOName, returnIOName] `plusFV` fvs )
307 -- NB: a foreign export is an *occurrence site* for name, so
308 -- we add it to the free-variable list. It might, for example,
309 -- be imported from another module
311 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
315 %*********************************************************
317 \subsection{Instance declarations}
319 %*********************************************************
322 rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
323 -- Used for both source and interface file decls
324 = addSrcLoc src_loc $
325 rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
327 (case maybe_dfun_rdr_name of
328 Nothing -> returnM Nothing
329 Just dfun_rdr_name -> lookupGlobalOccRn dfun_rdr_name `thenM` \ dfun_name ->
330 returnM (Just dfun_name)
331 ) `thenM` \ maybe_dfun_name ->
333 -- The typechecker checks that all the bindings are for the right class.
334 returnM (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
336 -- Compare finishSourceTyClDecl
337 finishSourceInstDecl (InstDecl _ mbinds uprags _ _ )
338 (InstDecl inst_ty _ _ maybe_dfun_name src_loc)
339 -- Used for both source decls only
340 = ASSERT( not (maybeToBool maybe_dfun_name) ) -- Source decl!
342 meth_doc = text "In the bindings in an instance declaration"
343 meth_names = collectLocatedMonoBinders mbinds
344 (inst_tyvars, _, cls,_) = splitHsInstDeclTy inst_ty
345 -- (Slightly strangely) the forall-d tyvars scope over
346 -- the method bindings too
349 -- Rename the bindings
350 -- NB meth_names can be qualified!
351 checkDupNames meth_doc meth_names `thenM_`
352 extendTyVarEnvForMethodBinds inst_tyvars (
353 rnMethodBinds cls [] mbinds
354 ) `thenM` \ (mbinds', meth_fvs) ->
356 binders = collectMonoBinders mbinds'
357 binder_set = mkNameSet binders
359 -- Rename the prags and signatures.
360 -- Note that the type variables are not in scope here,
361 -- so that instance Eq a => Eq (T a) where
362 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
365 -- But the (unqualified) method names are in scope
366 bindLocalNames binders (
367 renameSigsFVs (okInstDclSig binder_set) uprags
368 ) `thenM` \ (uprags', prag_fvs) ->
370 returnM (InstDecl inst_ty mbinds' uprags' maybe_dfun_name src_loc,
371 meth_fvs `plusFV` prag_fvs)
374 %*********************************************************
378 %*********************************************************
381 rnIfaceRuleDecl (IfaceRule rule_name act vars fn args rhs src_loc)
382 = addSrcLoc src_loc $
383 lookupOccRn fn `thenM` \ fn' ->
384 rnCoreBndrs vars $ \ vars' ->
385 mappM rnCoreExpr args `thenM` \ args' ->
386 rnCoreExpr rhs `thenM` \ rhs' ->
387 returnM (IfaceRule rule_name act vars' fn' args' rhs' src_loc)
389 rnIfaceRuleDecl (IfaceRuleOut fn rule) -- Builtin rules come this way
390 = lookupOccRn fn `thenM` \ fn' ->
391 returnM (IfaceRuleOut fn' rule)
393 rnHsRuleDecl (HsRule rule_name act vars lhs rhs src_loc)
394 = addSrcLoc src_loc $
395 bindPatSigTyVars (collectRuleBndrSigTys vars) $
397 bindLocalsFVRn doc (map get_var vars) $ \ ids ->
398 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
400 rnExpr lhs `thenM` \ (lhs', fv_lhs) ->
401 rnExpr rhs `thenM` \ (rhs', fv_rhs) ->
403 mb_bad = validRuleLhs ids lhs'
405 checkErr (isNothing mb_bad)
406 (badRuleLhsErr rule_name lhs' mb_bad) `thenM_`
408 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
410 mappM (addErr . badRuleVar rule_name) bad_vars `thenM_`
411 returnM (HsRule rule_name act vars' lhs' rhs' src_loc,
412 fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
414 doc = text "In the transformation rule" <+> ftext rule_name
416 get_var (RuleBndr v) = v
417 get_var (RuleBndrSig v _) = v
419 rn_var (RuleBndr v, id) = returnM (RuleBndr id, emptyFVs)
420 rn_var (RuleBndrSig v t, id) = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
421 returnM (RuleBndrSig id t', fvs)
424 Check the shape of a transformation rule LHS. Currently
425 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
426 not one of the @forall@'d variables. We also restrict the form of the LHS so
427 that it may be plausibly matched. Basically you only get to write ordinary
428 applications. (E.g. a case expression is not allowed: too elaborate.)
430 NB: if you add new cases here, make sure you add new ones to TcRule.ruleLhsTvs
433 validRuleLhs :: [Name] -> RenamedHsExpr -> Maybe RenamedHsExpr
435 -- Just e => Not ok, and e is the offending expression
436 validRuleLhs foralls lhs
439 check (OpApp e1 op _ e2) = check op `seqMaybe` check_e e1 `seqMaybe` check_e e2
440 check (HsApp e1 e2) = check e1 `seqMaybe` check_e e2
441 check (HsVar v) | v `notElem` foralls = Nothing
442 check other = Just other -- Failure
444 check_e (HsVar v) = Nothing
445 check_e (HsPar e) = check_e e
446 check_e (HsLit e) = Nothing
447 check_e (HsOverLit e) = Nothing
449 check_e (OpApp e1 op _ e2) = check_e e1 `seqMaybe` check_e op `seqMaybe` check_e e2
450 check_e (HsApp e1 e2) = check_e e1 `seqMaybe` check_e e2
451 check_e (NegApp e _) = check_e e
452 check_e (ExplicitList _ es) = check_es es
453 check_e (ExplicitTuple es _) = check_es es
454 check_e other = Just other -- Fails
456 check_es es = foldr (seqMaybe . check_e) Nothing es
460 %*********************************************************
462 \subsection{Type, class and iface sig declarations}
464 %*********************************************************
466 @rnTyDecl@ uses the `global name function' to create a new type
467 declaration in which local names have been replaced by their original
468 names, reporting any unknown names.
470 Renaming type variables is a pain. Because they now contain uniques,
471 it is necessary to pass in an association list which maps a parsed
472 tyvar to its @Name@ representation.
473 In some cases (type signatures of values),
474 it is even necessary to go over the type first
475 in order to get the set of tyvars used by it, make an assoc list,
476 and then go over it again to rename the tyvars!
477 However, we can also do some scoping checks at the same time.
480 rnTyClDecl (IfaceSig {tcdName = name, tcdType = ty, tcdIdInfo = id_infos, tcdLoc = loc})
482 lookupTopBndrRn name `thenM` \ name' ->
483 rnHsType doc_str ty `thenM` \ ty' ->
484 mappM rnIdInfo id_infos `thenM` \ id_infos' ->
485 returnM (IfaceSig {tcdName = name', tcdType = ty', tcdIdInfo = id_infos', tcdLoc = loc})
487 doc_str = text "In the interface signature for" <+> quotes (ppr name)
489 rnTyClDecl (ForeignType {tcdName = name, tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
491 lookupTopBndrRn name `thenM` \ name' ->
492 returnM (ForeignType {tcdName = name', tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
494 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
495 tcdTyVars = tyvars, tcdCons = condecls, tcdGeneric = want_generic,
496 tcdDerivs = derivs, tcdLoc = src_loc})
497 = addSrcLoc src_loc $
498 lookupTopBndrRn tycon `thenM` \ tycon' ->
499 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
500 rnContext data_doc context `thenM` \ context' ->
501 rn_derivs derivs `thenM` \ derivs' ->
502 checkDupOrQualNames data_doc con_names `thenM_`
504 rnConDecls tycon' condecls `thenM` \ condecls' ->
505 returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdName = tycon',
506 tcdTyVars = tyvars', tcdCons = condecls', tcdGeneric = want_generic,
507 tcdDerivs = derivs', tcdLoc = src_loc})
509 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
510 con_names = map conDeclName (visibleDataCons condecls)
512 rn_derivs Nothing = returnM Nothing
513 rn_derivs (Just ds) = rnContext data_doc ds `thenM` \ ds' -> returnM (Just ds')
515 rnTyClDecl (TySynonym {tcdName = name, tcdTyVars = tyvars, tcdSynRhs = ty, tcdLoc = src_loc})
516 = addSrcLoc src_loc $
517 lookupTopBndrRn name `thenM` \ name' ->
518 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
519 rnHsType syn_doc ty `thenM` \ ty' ->
520 returnM (TySynonym {tcdName = name', tcdTyVars = tyvars', tcdSynRhs = ty', tcdLoc = src_loc})
522 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
524 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
525 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
527 -- Used for both source and interface file decls
528 = addSrcLoc src_loc $
530 lookupTopBndrRn cname `thenM` \ cname' ->
532 -- Tyvars scope over superclass context and method signatures
533 bindTyVarsRn cls_doc tyvars $ \ tyvars' ->
535 -- Check the superclasses
536 rnContext cls_doc context `thenM` \ context' ->
538 -- Check the functional dependencies
539 rnFds cls_doc fds `thenM` \ fds' ->
541 -- Check the signatures
542 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
544 (op_sigs, non_op_sigs) = partition isClassOpSig sigs
545 sig_rdr_names_w_locs = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
547 checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenM_`
548 mappM (rnClassOp cname' fds') op_sigs `thenM` \ sigs' ->
550 binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
552 renameSigs (okClsDclSig binders) non_op_sigs `thenM` \ non_ops' ->
554 -- Typechecker is responsible for checking that we only
555 -- give default-method bindings for things in this class.
556 -- The renamer *could* check this for class decls, but can't
557 -- for instance decls.
559 returnM (ClassDecl { tcdCtxt = context', tcdName = cname', tcdTyVars = tyvars',
560 tcdFDs = fds', tcdSigs = non_ops' ++ sigs', tcdMeths = Nothing,
563 cls_doc = text "In the declaration for class" <+> ppr cname
564 sig_doc = text "In the signatures for class" <+> ppr cname
566 rnClassOp clas clas_fds sig@(ClassOpSig op dm_stuff ty locn)
568 lookupTopBndrRn op `thenM` \ op_name ->
570 -- Check the signature
571 rnHsSigType (quotes (ppr op)) ty `thenM` \ new_ty ->
573 -- Make the default-method name
576 -> -- Imported class that has a default method decl
577 lookupSysBndr dm_rdr_name `thenM` \ dm_name ->
578 returnM (DefMeth dm_name)
579 -- An imported class decl for a class decl that had an explicit default
580 -- method, mentions, rather than defines,
581 -- the default method, so we must arrange to pull it in
583 GenDefMeth -> returnM GenDefMeth
584 NoDefMeth -> returnM NoDefMeth
585 ) `thenM` \ dm_stuff' ->
587 returnM (ClassOpSig op_name dm_stuff' new_ty locn)
589 finishSourceTyClDecl :: RdrNameTyClDecl -> RenamedTyClDecl -> RnM (RenamedTyClDecl, FreeVars)
590 -- Used for source file decls only
591 -- Renames the default-bindings of a class decl
592 finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc}) -- Get mbinds from here
593 rn_cls_decl@(ClassDecl {tcdName = cls, tcdTyVars = tyvars}) -- Everything else is here
594 -- There are some default-method bindings (abeit possibly empty) so
595 -- this is a source-code class declaration
596 = -- The newLocals call is tiresome: given a generic class decl
599 -- op {| x+y |} (Inl a) = ...
600 -- op {| x+y |} (Inr b) = ...
601 -- op {| a*b |} (a*b) = ...
602 -- we want to name both "x" tyvars with the same unique, so that they are
603 -- easy to group together in the typechecker.
606 extendTyVarEnvForMethodBinds tyvars $
607 getLocalRdrEnv `thenM` \ name_env ->
609 meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
610 gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
611 not (tv `elemRdrEnv` name_env)]
613 checkDupOrQualNames meth_doc meth_rdr_names_w_locs `thenM_`
614 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
615 rnMethodBinds cls gen_tyvars mbinds `thenM` \ (mbinds', meth_fvs) ->
616 returnM (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)
618 meth_doc = text "In the default-methods for class" <+> ppr (tcdName rn_cls_decl)
620 finishSourceTyClDecl _ tycl_decl@(TyData {tcdDerivs = derivings})
621 -- Derivings are returned here so that they don't form part of the tyClDeclFVs.
622 -- This is important, because tyClDeclFVs should contain only the
623 -- FVs that are `needed' by the interface file declaration, and
624 -- derivings do not appear in this. It also means that the tcGroups
625 -- are smaller, which turned out to be important for the usage inference. KSW 2002-02.
626 = returnM (tycl_decl,
627 maybe emptyFVs extractHsCtxtTyNames derivings)
629 finishSourceTyClDecl _ tycl_decl = returnM (tycl_decl, emptyFVs)
630 -- Not a class declaration
633 For the method bindings in class and instance decls, we extend the
634 type variable environment iff -fglasgow-exts
637 extendTyVarEnvForMethodBinds tyvars thing_inside
638 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
639 if opt_GlasgowExts then
640 extendTyVarEnvFVRn (map hsTyVarName tyvars) thing_inside
646 %*********************************************************
648 \subsection{Support code for type/data declarations}
650 %*********************************************************
653 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
654 conDeclName (ConDecl n _ _ _ l) = (n,l)
656 rnConDecls :: Name -> DataConDetails RdrNameConDecl -> RnM (DataConDetails RenamedConDecl)
657 rnConDecls tycon Unknown = returnM Unknown
658 rnConDecls tycon (HasCons n) = returnM (HasCons n)
659 rnConDecls tycon (DataCons condecls)
660 = -- Check that there's at least one condecl,
661 -- or else we're reading an interface file, or -fglasgow-exts
662 (if null condecls then
663 doptM Opt_GlasgowExts `thenM` \ glaExts ->
664 getModeRn `thenM` \ mode ->
665 checkErr (glaExts || isInterfaceMode mode)
666 (emptyConDeclsErr tycon)
670 mappM rnConDecl condecls `thenM` \ condecls' ->
671 returnM (DataCons condecls')
673 rnConDecl :: RdrNameConDecl -> RnM RenamedConDecl
674 rnConDecl (ConDecl name tvs cxt details locn)
676 checkConName name `thenM_`
677 lookupTopBndrRn name `thenM` \ new_name ->
679 bindTyVarsRn doc tvs $ \ new_tyvars ->
680 rnContext doc cxt `thenM` \ new_context ->
681 rnConDetails doc locn details `thenM` \ new_details ->
682 returnM (ConDecl new_name new_tyvars new_context new_details locn)
684 doc = text "In the definition of data constructor" <+> quotes (ppr name)
686 rnConDetails doc locn (PrefixCon tys)
687 = mappM (rnBangTy doc) tys `thenM` \ new_tys ->
688 returnM (PrefixCon new_tys)
690 rnConDetails doc locn (InfixCon ty1 ty2)
691 = rnBangTy doc ty1 `thenM` \ new_ty1 ->
692 rnBangTy doc ty2 `thenM` \ new_ty2 ->
693 returnM (InfixCon new_ty1 new_ty2)
695 rnConDetails doc locn (RecCon fields)
696 = checkDupOrQualNames doc field_names `thenM_`
697 mappM (rnField doc) fields `thenM` \ new_fields ->
698 returnM (RecCon new_fields)
700 field_names = [(fld, locn) | (fld, _) <- fields]
702 rnField doc (name, ty)
703 = lookupTopBndrRn name `thenM` \ new_name ->
704 rnBangTy doc ty `thenM` \ new_ty ->
705 returnM (new_name, new_ty)
707 rnBangTy doc (BangType s ty)
708 = rnHsType doc ty `thenM` \ new_ty ->
709 returnM (BangType s new_ty)
711 -- This data decl will parse OK
713 -- treating "a" as the constructor.
714 -- It is really hard to make the parser spot this malformation.
715 -- So the renamer has to check that the constructor is legal
717 -- We can get an operator as the constructor, even in the prefix form:
718 -- data T = :% Int Int
719 -- from interface files, which always print in prefix form
722 = checkErr (isRdrDataCon name) (badDataCon name)
726 %*********************************************************
728 \subsection{Support code to rename types}
730 %*********************************************************
733 rnFds :: SDoc -> [FunDep RdrName] -> RnM [FunDep Name]
739 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
740 rnHsTyVars doc tys2 `thenM` \ tys2' ->
741 returnM (tys1', tys2')
743 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
744 rnHsTyvar doc tyvar = lookupOccRn tyvar
747 %*********************************************************
751 %*********************************************************
754 rnIdInfo (HsWorker worker arity)
755 = lookupOccRn worker `thenM` \ worker' ->
756 returnM (HsWorker worker' arity)
758 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenM` \ expr' ->
759 returnM (HsUnfold inline expr')
760 rnIdInfo (HsStrictness str) = returnM (HsStrictness str)
761 rnIdInfo (HsArity arity) = returnM (HsArity arity)
762 rnIdInfo HsNoCafRefs = returnM HsNoCafRefs
765 @UfCore@ expressions.
768 rnCoreExpr (UfType ty)
769 = rnHsType (text "unfolding type") ty `thenM` \ ty' ->
773 = lookupOccRn v `thenM` \ v' ->
779 rnCoreExpr (UfLitLit l ty)
780 = rnHsType (text "litlit") ty `thenM` \ ty' ->
781 returnM (UfLitLit l ty')
783 rnCoreExpr (UfFCall cc ty)
784 = rnHsType (text "ccall") ty `thenM` \ ty' ->
785 returnM (UfFCall cc ty')
787 rnCoreExpr (UfTuple (HsTupCon boxity arity) args)
788 = mappM rnCoreExpr args `thenM` \ args' ->
789 returnM (UfTuple (HsTupCon boxity arity) args')
791 rnCoreExpr (UfApp fun arg)
792 = rnCoreExpr fun `thenM` \ fun' ->
793 rnCoreExpr arg `thenM` \ arg' ->
794 returnM (UfApp fun' arg')
796 rnCoreExpr (UfCase scrut bndr alts)
797 = rnCoreExpr scrut `thenM` \ scrut' ->
798 bindCoreLocalRn bndr $ \ bndr' ->
799 mappM rnCoreAlt alts `thenM` \ alts' ->
800 returnM (UfCase scrut' bndr' alts')
802 rnCoreExpr (UfNote note expr)
803 = rnNote note `thenM` \ note' ->
804 rnCoreExpr expr `thenM` \ expr' ->
805 returnM (UfNote note' expr')
807 rnCoreExpr (UfLam bndr body)
808 = rnCoreBndr bndr $ \ bndr' ->
809 rnCoreExpr body `thenM` \ body' ->
810 returnM (UfLam bndr' body')
812 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
813 = rnCoreExpr rhs `thenM` \ rhs' ->
814 rnCoreBndr bndr $ \ bndr' ->
815 rnCoreExpr body `thenM` \ body' ->
816 returnM (UfLet (UfNonRec bndr' rhs') body')
818 rnCoreExpr (UfLet (UfRec pairs) body)
819 = rnCoreBndrs bndrs $ \ bndrs' ->
820 mappM rnCoreExpr rhss `thenM` \ rhss' ->
821 rnCoreExpr body `thenM` \ body' ->
822 returnM (UfLet (UfRec (bndrs' `zip` rhss')) body')
824 (bndrs, rhss) = unzip pairs
828 rnCoreBndr (UfValBinder name ty) thing_inside
829 = rnHsType doc ty `thenM` \ ty' ->
830 bindCoreLocalRn name $ \ name' ->
831 thing_inside (UfValBinder name' ty')
833 doc = text "unfolding id"
835 rnCoreBndr (UfTyBinder name kind) thing_inside
836 = bindCoreLocalRn name $ \ name' ->
837 thing_inside (UfTyBinder name' kind)
839 rnCoreBndrs [] thing_inside = thing_inside []
840 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b $ \ name' ->
841 rnCoreBndrs bs $ \ names' ->
842 thing_inside (name':names')
846 rnCoreAlt (con, bndrs, rhs)
847 = rnUfCon con `thenM` \ con' ->
848 bindCoreLocalsRn bndrs $ \ bndrs' ->
849 rnCoreExpr rhs `thenM` \ rhs' ->
850 returnM (con', bndrs', rhs')
853 = rnHsType (text "unfolding coerce") ty `thenM` \ ty' ->
854 returnM (UfCoerce ty')
856 rnNote (UfSCC cc) = returnM (UfSCC cc)
857 rnNote UfInlineCall = returnM UfInlineCall
858 rnNote UfInlineMe = returnM UfInlineMe
864 rnUfCon (UfTupleAlt tup_con)
865 = returnM (UfTupleAlt tup_con)
867 rnUfCon (UfDataAlt con)
868 = lookupOccRn con `thenM` \ con' ->
869 returnM (UfDataAlt con')
871 rnUfCon (UfLitAlt lit)
872 = returnM (UfLitAlt lit)
874 rnUfCon (UfLitLitAlt lit ty)
875 = rnHsType (text "litlit") ty `thenM` \ ty' ->
876 returnM (UfLitLitAlt lit ty')
879 %*********************************************************
881 \subsection{Statistics}
883 %*********************************************************
886 rnStats :: [RenamedHsDecl] -- Imported decls
889 = doptM Opt_D_dump_rn_trace `thenM` \ dump_rn_trace ->
890 doptM Opt_D_dump_rn_stats `thenM` \ dump_rn_stats ->
891 doptM Opt_D_dump_rn `thenM` \ dump_rn ->
892 getEps `thenM` \ eps ->
894 ioToTcRn (dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
896 (getRnStats eps imp_decls)) `thenM_`
899 getRnStats :: ExternalPackageState -> [RenamedHsDecl] -> SDoc
900 getRnStats eps imported_decls
901 = hcat [text "Renamer stats: ", stats]
903 n_mods = length [() | _ <- moduleEnvElts (eps_PIT eps)]
904 -- This is really only right for a one-shot compile
906 (decls_map, n_decls_slurped) = eps_decls eps
908 n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
909 -- Data, newtype, and class decls are in the decls_fm
910 -- under multiple names; the tycon/class, and each
911 -- constructor/class op too.
912 -- The 'True' selects just the 'main' decl
915 (insts_left, n_insts_slurped) = eps_insts eps
916 n_insts_left = length (bagToList insts_left)
918 (rules_left, n_rules_slurped) = eps_rules eps
919 n_rules_left = length (bagToList rules_left)
922 [int n_mods <+> text "interfaces read",
923 hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
924 int (n_decls_slurped + n_decls_left), text "read"],
925 hsep [ int n_insts_slurped, text "instance decls imported, out of",
926 int (n_insts_slurped + n_insts_left), text "read"],
927 hsep [ int n_rules_slurped, text "rule decls imported, out of",
928 int (n_rules_slurped + n_rules_left), text "read"]
932 %*********************************************************
936 %*********************************************************
940 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
942 badRuleLhsErr name lhs (Just bad_e)
943 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
944 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
945 ptext SLIT("in left-hand side:") <+> ppr lhs])]
947 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
950 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
951 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
952 ptext SLIT("does not appear on left hand side")]
954 emptyConDeclsErr tycon
955 = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
956 nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]