[project @ 2004-09-30 10:35:15 by simonpj]
[ghc-hetmet.git] / ghc / compiler / rename / RnSource.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4 \section[RnSource]{Main pass of renamer}
5
6 \begin{code}
7 module RnSource ( 
8         rnSrcDecls, addTcgDUs, 
9         rnTyClDecls, checkModDeprec,
10         rnBindGroups, rnBindGroupsAndThen, rnSplice
11     ) where
12
13 #include "HsVersions.h"
14
15 import HsSyn
16 import RdrName          ( RdrName, isRdrDataCon, rdrNameOcc, elemLocalRdrEnv )
17 import RdrHsSyn         ( extractGenericPatTyVars )
18 import RnHsSyn
19 import RnExpr           ( rnLExpr, checkTH )
20 import RnTypes          ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
21 import RnBinds          ( rnTopBinds, rnBinds, rnMethodBinds, 
22                           rnBindsAndThen, renameSigs, checkSigs )
23 import RnEnv            ( lookupTopBndrRn, lookupTopFixSigNames,
24                           lookupLocatedTopBndrRn, lookupLocatedOccRn,
25                           lookupOccRn, newLocalsRn, 
26                           bindLocatedLocalsFV, bindPatSigTyVarsFV,
27                           bindTyVarsRn, extendTyVarEnvFVRn,
28                           bindLocalNames, newIPNameRn,
29                           checkDupNames, mapFvRn,
30                           unknownNameErr
31                         )
32 import TcRnMonad
33
34 import BasicTypes       ( TopLevelFlag(..)  )
35 import HscTypes         ( FixityEnv, FixItem(..),
36                           Deprecations, Deprecs(..), DeprecTxt, plusDeprecs )
37 import Class            ( FunDep )
38 import Name             ( Name )
39 import NameSet
40 import NameEnv
41 import Outputable
42 import SrcLoc           ( Located(..), unLoc, getLoc, noLoc )
43 import CmdLineOpts      ( DynFlag(..) )
44                                 -- Warn of unused for-all'd tyvars
45 import Maybes           ( seqMaybe )
46 import Maybe            ( catMaybes, isNothing )
47 \end{code}
48
49 @rnSourceDecl@ `renames' declarations.
50 It simultaneously performs dependency analysis and precedence parsing.
51 It also does the following error checks:
52 \begin{enumerate}
53 \item
54 Checks that tyvars are used properly. This includes checking
55 for undefined tyvars, and tyvars in contexts that are ambiguous.
56 (Some of this checking has now been moved to module @TcMonoType@,
57 since we don't have functional dependency information at this point.)
58 \item
59 Checks that all variable occurences are defined.
60 \item 
61 Checks the @(..)@ etc constraints in the export list.
62 \end{enumerate}
63
64
65 \begin{code}
66 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
67
68 rnSrcDecls (HsGroup { hs_valds  = [HsBindGroup binds sigs _],
69                       hs_tyclds = tycl_decls,
70                       hs_instds = inst_decls,
71                       hs_fixds  = fix_decls,
72                       hs_depds  = deprec_decls,
73                       hs_fords  = foreign_decls,
74                       hs_defds  = default_decls,
75                       hs_ruleds = rule_decls })
76
77  = do {         -- Deal with deprecations (returns only the extra deprecations)
78         deprecs <- rnSrcDeprecDecls deprec_decls ;
79         updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
80                   $ do {
81
82                 -- Deal with top-level fixity decls 
83                 -- (returns the total new fixity env)
84         fix_env <- rnSrcFixityDecls fix_decls ;
85         updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
86                   $ do {
87
88                 -- Rename other declarations
89         traceRn (text "Start rnmono") ;
90         (rn_val_decls, bind_dus) <- rnTopBinds binds sigs ;
91         traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
92
93                 -- You might think that we could build proper def/use information
94                 -- for type and class declarations, but they can be involved
95                 -- in mutual recursion across modules, and we only do the SCC
96                 -- analysis for them in the type checker.
97                 -- So we content ourselves with gathering uses only; that
98                 -- means we'll only report a declaration as unused if it isn't
99                 -- mentioned at all.  Ah well.
100         (rn_tycl_decls,    src_fvs1)
101            <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls ;
102         (rn_inst_decls,    src_fvs2)
103            <- mapFvRn (wrapLocFstM rnSrcInstDecl) inst_decls ;
104         (rn_rule_decls,    src_fvs3)
105            <- mapFvRn (wrapLocFstM rnHsRuleDecl) rule_decls ;
106         (rn_foreign_decls, src_fvs4)
107            <- mapFvRn (wrapLocFstM rnHsForeignDecl) foreign_decls ;
108         (rn_default_decls, src_fvs5)
109            <- mapFvRn (wrapLocFstM rnDefaultDecl) default_decls ;
110         
111         let {
112            rn_group = HsGroup { hs_valds  = rn_val_decls,
113                                 hs_tyclds = rn_tycl_decls,
114                                 hs_instds = rn_inst_decls,
115                                 hs_fixds  = [],
116                                 hs_depds  = [],
117                                 hs_fords  = rn_foreign_decls,
118                                 hs_defds  = rn_default_decls,
119                                 hs_ruleds = rn_rule_decls } ;
120
121            other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, 
122                                 src_fvs4, src_fvs5] ;
123            src_dus = bind_dus `plusDU` usesOnly other_fvs 
124         } ;
125
126         traceRn (text "finish rnSrc" <+> ppr rn_group) ;
127         tcg_env <- getGblEnv ;
128         return (tcg_env `addTcgDUs` src_dus, rn_group)
129     }}}
130
131 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
132 rnTyClDecls tycl_decls = do 
133   (decls', fvs) <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls
134   return decls'
135
136 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv 
137 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
138 \end{code}
139
140
141 %*********************************************************
142 %*                                                       *
143         Source-code fixity declarations
144 %*                                                       *
145 %*********************************************************
146
147 \begin{code}
148 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM FixityEnv
149 rnSrcFixityDecls fix_decls
150   = getGblEnv                                   `thenM` \ gbl_env ->
151     foldlM rnFixityDecl (tcg_fix_env gbl_env) 
152             fix_decls                                   `thenM` \ fix_env ->
153     traceRn (text "fixity env" <+> pprFixEnv fix_env)   `thenM_`
154     returnM fix_env
155
156 rnFixityDecl :: FixityEnv -> LFixitySig RdrName -> RnM FixityEnv
157 rnFixityDecl fix_env (L loc (FixitySig rdr_name fixity))
158   = setSrcSpan loc $
159         -- GHC extension: look up both the tycon and data con 
160         -- for con-like things
161         -- If neither are in scope, report an error; otherwise
162         -- add both to the fixity env
163      addLocM lookupTopFixSigNames rdr_name      `thenM` \ names ->
164      if null names then
165           addLocErr rdr_name unknownNameErr     `thenM_`
166           returnM fix_env
167      else
168           foldlM add fix_env names
169   where
170     add fix_env name
171       = case lookupNameEnv fix_env name of
172           Just (FixItem _ _ loc') 
173                   -> addLocErr rdr_name (dupFixityDecl loc')    `thenM_`
174                      returnM fix_env
175           Nothing -> returnM (extendNameEnv fix_env name fix_item)
176       where
177         fix_item = FixItem (rdrNameOcc (unLoc rdr_name)) fixity
178                          (getLoc rdr_name)
179
180 pprFixEnv :: FixityEnv -> SDoc
181 pprFixEnv env 
182   = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
183                   (nameEnvElts env)
184
185 dupFixityDecl loc rdr_name
186   = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
187           ptext SLIT("also at ") <+> ppr loc
188         ]
189 \end{code}
190
191
192 %*********************************************************
193 %*                                                       *
194         Source-code deprecations declarations
195 %*                                                       *
196 %*********************************************************
197
198 For deprecations, all we do is check that the names are in scope.
199 It's only imported deprecations, dealt with in RnIfaces, that we
200 gather them together.
201
202 \begin{code}
203 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
204 rnSrcDeprecDecls [] 
205   = returnM NoDeprecs
206
207 rnSrcDeprecDecls decls
208   = mappM (addLocM rn_deprec) decls     `thenM` \ pairs ->
209     returnM (DeprecSome (mkNameEnv (catMaybes pairs)))
210  where
211    rn_deprec (Deprecation rdr_name txt)
212      = lookupTopBndrRn rdr_name `thenM` \ name ->
213        returnM (Just (name, (rdrNameOcc rdr_name, txt)))
214
215 checkModDeprec :: Maybe DeprecTxt -> Deprecations
216 -- Check for a module deprecation; done once at top level
217 checkModDeprec Nothing    = NoDeprecs
218 checkModDeprec (Just txt) = DeprecAll txt
219 \end{code}
220
221 %*********************************************************
222 %*                                                      *
223 \subsection{Source code declarations}
224 %*                                                      *
225 %*********************************************************
226
227 \begin{code}
228 rnDefaultDecl (DefaultDecl tys)
229   = mapFvRn (rnHsTypeFVs doc_str) tys   `thenM` \ (tys', fvs) ->
230     returnM (DefaultDecl tys', fvs)
231   where
232     doc_str = text "In a `default' declaration"
233 \end{code}
234
235 %*********************************************************
236 %*                                                      *
237                 Bindings
238 %*                                                      *
239 %*********************************************************
240
241 These chaps are here, rather than in TcBinds, so that there
242 is just one hi-boot file (for RnSource).  rnSrcDecls is part
243 of the loop too, and it must be defined in this module.
244
245 \begin{code}
246 rnBindGroups :: [HsBindGroup RdrName] -> RnM ([HsBindGroup Name], DefUses)
247 -- This version assumes that the binders are already in scope
248 -- It's used only in 'mdo'
249 rnBindGroups []
250    = returnM ([], emptyDUs)
251 rnBindGroups [HsBindGroup bind sigs _]
252    = rnBinds NotTopLevel bind sigs
253 rnBindGroups b@[HsIPBinds bind]
254    = do addErr (badIpBinds b)   
255         returnM ([], emptyDUs)
256 rnBindGroups _
257    = panic "rnBindGroups"
258
259 rnBindGroupsAndThen 
260   :: [HsBindGroup RdrName]
261   -> ([HsBindGroup Name] -> RnM (result, FreeVars))
262   -> RnM (result, FreeVars)
263 -- This version (a) assumes that the binding vars are not already in scope
264 --              (b) removes the binders from the free vars of the thing inside
265 -- The parser doesn't produce ThenBinds
266 rnBindGroupsAndThen [] thing_inside
267   = thing_inside []
268 rnBindGroupsAndThen [HsBindGroup bind sigs _] thing_inside
269   = rnBindsAndThen bind sigs $ \ groups -> thing_inside groups
270 rnBindGroupsAndThen [HsIPBinds binds] thing_inside
271   = rnIPBinds binds                     `thenM` \ (binds',fv_binds) ->
272     thing_inside [HsIPBinds binds']     `thenM` \ (thing, fvs_thing) ->
273     returnM (thing, fvs_thing `plusFV` fv_binds)
274
275 rnIPBinds [] = returnM ([], emptyFVs)
276 rnIPBinds (bind : binds)
277   = wrapLocFstM rnIPBind bind   `thenM` \ (bind', fvBind) ->
278     rnIPBinds binds             `thenM` \ (binds',fvBinds) ->
279     returnM (bind' : binds', fvBind `plusFV` fvBinds)
280
281 rnIPBind (IPBind n expr)
282   = newIPNameRn  n              `thenM` \ name ->
283     rnLExpr expr                `thenM` \ (expr',fvExpr) ->
284     return (IPBind name expr', fvExpr)
285
286 badIpBinds binds
287   = hang (ptext SLIT("Implicit-parameter bindings illegal in 'mdo':")) 4
288          (ppr binds)
289 \end{code}
290
291
292 %*********************************************************
293 %*                                                      *
294 \subsection{Foreign declarations}
295 %*                                                      *
296 %*********************************************************
297
298 \begin{code}
299 rnHsForeignDecl (ForeignImport name ty spec isDeprec)
300   = lookupLocatedTopBndrRn name         `thenM` \ name' ->
301     rnHsTypeFVs (fo_decl_msg name) ty   `thenM` \ (ty', fvs) ->
302     returnM (ForeignImport name' ty' spec isDeprec, fvs)
303
304 rnHsForeignDecl (ForeignExport name ty spec isDeprec)
305   = lookupLocatedOccRn name             `thenM` \ name' ->
306     rnHsTypeFVs (fo_decl_msg name) ty   `thenM` \ (ty', fvs) ->
307     returnM (ForeignExport name' ty' spec isDeprec, fvs )
308         -- NB: a foreign export is an *occurrence site* for name, so 
309         --     we add it to the free-variable list.  It might, for example,
310         --     be imported from another module
311
312 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
313 \end{code}
314
315
316 %*********************************************************
317 %*                                                      *
318 \subsection{Instance declarations}
319 %*                                                      *
320 %*********************************************************
321
322 \begin{code}
323 rnSrcInstDecl (InstDecl inst_ty mbinds uprags)
324         -- Used for both source and interface file decls
325   = rnHsSigType (text "an instance decl") inst_ty       `thenM` \ inst_ty' ->
326
327         -- Rename the bindings
328         -- The typechecker (not the renamer) checks that all 
329         -- the bindings are for the right class
330     let
331         meth_doc    = text "In the bindings in an instance declaration"
332         meth_names  = collectHsBindLocatedBinders mbinds
333         (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
334     in
335     checkDupNames meth_doc meth_names   `thenM_`
336     extendTyVarEnvForMethodBinds inst_tyvars (          
337         -- (Slightly strangely) the forall-d tyvars scope over
338         -- the method bindings too
339         rnMethodBinds cls [] mbinds
340     )                                           `thenM` \ (mbinds', meth_fvs) ->
341         -- Rename the prags and signatures.
342         -- Note that the type variables are not in scope here,
343         -- so that      instance Eq a => Eq (T a) where
344         --                      {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
345         -- works OK. 
346         --
347         -- But the (unqualified) method names are in scope
348     let 
349         binders = collectHsBindBinders mbinds'
350     in
351     bindLocalNames binders (renameSigs uprags)                  `thenM` \ uprags' ->
352     checkSigs (okInstDclSig (mkNameSet binders)) uprags'        `thenM_`
353
354     returnM (InstDecl inst_ty' mbinds' uprags',
355              meth_fvs `plusFV` hsSigsFVs uprags'
356                       `plusFV` extractHsTyNames inst_ty')
357 \end{code}
358
359 For the method bindings in class and instance decls, we extend the 
360 type variable environment iff -fglasgow-exts
361
362 \begin{code}
363 extendTyVarEnvForMethodBinds tyvars thing_inside
364   = doptM Opt_GlasgowExts                       `thenM` \ opt_GlasgowExts ->
365     if opt_GlasgowExts then
366         extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
367     else
368         thing_inside
369 \end{code}
370
371
372 %*********************************************************
373 %*                                                      *
374 \subsection{Rules}
375 %*                                                      *
376 %*********************************************************
377
378 \begin{code}
379 rnHsRuleDecl (HsRule rule_name act vars lhs rhs)
380   = bindPatSigTyVarsFV (collectRuleBndrSigTys vars)     $
381
382     bindLocatedLocalsFV doc (map get_var vars)          $ \ ids ->
383     mapFvRn rn_var (vars `zip` ids)             `thenM` \ (vars', fv_vars) ->
384
385     rnLExpr lhs                                 `thenM` \ (lhs', fv_lhs) ->
386     rnLExpr rhs                                 `thenM` \ (rhs', fv_rhs) ->
387     let
388         mb_bad = validRuleLhs ids lhs'
389     in
390     checkErr (isNothing mb_bad)
391              (badRuleLhsErr rule_name lhs' mb_bad)      `thenM_`
392     let
393         bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
394     in
395     mappM (addErr . badRuleVar rule_name) bad_vars      `thenM_`
396     returnM (HsRule rule_name act vars' lhs' rhs',
397              fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
398   where
399     doc = text "In the transformation rule" <+> ftext rule_name
400   
401     get_var (RuleBndr v)      = v
402     get_var (RuleBndrSig v _) = v
403
404     rn_var (RuleBndr (L loc v), id)
405         = returnM (RuleBndr (L loc id), emptyFVs)
406     rn_var (RuleBndrSig (L loc v) t, id)
407         = rnHsTypeFVs doc t     `thenM` \ (t', fvs) ->
408           returnM (RuleBndrSig (L loc id) t', fvs)
409 \end{code}
410
411 Check the shape of a transformation rule LHS.  Currently
412 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
413 not one of the @forall@'d variables.  We also restrict the form of the LHS so
414 that it may be plausibly matched.  Basically you only get to write ordinary 
415 applications.  (E.g. a case expression is not allowed: too elaborate.)
416
417 NB: if you add new cases here, make sure you add new ones to TcRule.ruleLhsTvs
418
419 \begin{code}
420 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
421 -- Nothing => OK
422 -- Just e  => Not ok, and e is the offending expression
423 validRuleLhs foralls lhs
424   = checkl lhs
425   where
426     checkl (L loc e) = check e
427
428     check (OpApp e1 op _ e2)              = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
429     check (HsApp e1 e2)                   = checkl e1 `seqMaybe` checkl_e e2
430     check (HsVar v) | v `notElem` foralls = Nothing
431     check other                           = Just other  -- Failure
432
433     checkl_e (L loc e) = check_e e
434
435     check_e (HsVar v)     = Nothing
436     check_e (HsPar e)     = checkl_e e
437     check_e (HsLit e)     = Nothing
438     check_e (HsOverLit e) = Nothing
439
440     check_e (OpApp e1 op _ e2)   = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
441     check_e (HsApp e1 e2)        = checkl_e e1 `seqMaybe` checkl_e e2
442     check_e (NegApp e _)         = checkl_e e
443     check_e (ExplicitList _ es)  = checkl_es es
444     check_e (ExplicitTuple es _) = checkl_es es
445     check_e other                = Just other   -- Fails
446
447     checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
448
449 badRuleLhsErr name lhs (Just bad_e)
450   = sep [ptext SLIT("Rule") <+> ftext name <> colon,
451          nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e, 
452                        ptext SLIT("in left-hand side:") <+> ppr lhs])]
453     $$
454     ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
455
456 badRuleVar name var
457   = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
458          ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+> 
459                 ptext SLIT("does not appear on left hand side")]
460 \end{code}
461
462
463 %*********************************************************
464 %*                                                      *
465 \subsection{Type, class and iface sig declarations}
466 %*                                                      *
467 %*********************************************************
468
469 @rnTyDecl@ uses the `global name function' to create a new type
470 declaration in which local names have been replaced by their original
471 names, reporting any unknown names.
472
473 Renaming type variables is a pain. Because they now contain uniques,
474 it is necessary to pass in an association list which maps a parsed
475 tyvar to its @Name@ representation.
476 In some cases (type signatures of values),
477 it is even necessary to go over the type first
478 in order to get the set of tyvars used by it, make an assoc list,
479 and then go over it again to rename the tyvars!
480 However, we can also do some scoping checks at the same time.
481
482 \begin{code}
483 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
484   = lookupLocatedTopBndrRn name         `thenM` \ name' ->
485     returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
486              emptyFVs)
487
488 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = tycon,
489                     tcdTyVars = tyvars, tcdCons = condecls, 
490                     tcdDerivs = derivs})
491   | is_vanilla  -- Normal Haskell data type decl
492   = bindTyVarsRn data_doc tyvars                $ \ tyvars' ->
493     do  { tycon' <- lookupLocatedTopBndrRn tycon
494         ; context' <- rnContext data_doc context
495         ; (derivs', deriv_fvs) <- rn_derivs derivs
496         ; checkDupNames data_doc con_names
497         ; condecls' <- rnConDecls (unLoc tycon') condecls
498         ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdLName = tycon',
499                            tcdTyVars = tyvars', tcdCons = condecls', 
500                            tcdDerivs = derivs'}, 
501                    delFVs (map hsLTyVarName tyvars')    $
502                    extractHsCtxtTyNames context'        `plusFV`
503                    plusFVs (map conDeclFVs condecls') `plusFV`
504                    deriv_fvs) }
505
506   | otherwise   -- GADT
507   = ASSERT( null (unLoc context) )
508     do  { tycon' <- lookupLocatedTopBndrRn tycon
509         ; tyvars' <- bindTyVarsRn data_doc tyvars 
510                                   (\ tyvars' -> return tyvars')
511                 -- For GADTs, the type variables in the declaration 
512                 -- do not scope over the constructor signatures
513                 --      data T a where { T1 :: forall b. b-> b }
514         ; (derivs', deriv_fvs) <- rn_derivs derivs
515         ; checkDupNames data_doc con_names
516         ; condecls' <- rnConDecls (unLoc tycon') condecls
517         ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [], tcdLName = tycon',
518                            tcdTyVars = tyvars', tcdCons = condecls', 
519                            tcdDerivs = derivs'}, 
520                    plusFVs (map conDeclFVs condecls') `plusFV` deriv_fvs) }
521
522   where
523     is_vanilla = case condecls of       -- Yuk
524                      []                    -> True
525                      L _ (ConDecl {}) : _  -> True
526                      other                 -> False
527
528     data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
529     con_names = map con_names_helper condecls
530
531     con_names_helper (L _ (ConDecl n _ _ _)) = n
532     con_names_helper (L _ (GadtDecl n _)) = n
533
534     rn_derivs Nothing   = returnM (Nothing, emptyFVs)
535     rn_derivs (Just ds) = rnLHsTypes data_doc ds        `thenM` \ ds' -> 
536                           returnM (Just ds', extractHsTyNames_s ds')
537     
538 rnTyClDecl (TySynonym {tcdLName = name, tcdTyVars = tyvars, tcdSynRhs = ty})
539   = lookupLocatedTopBndrRn name                 `thenM` \ name' ->
540     bindTyVarsRn syn_doc tyvars                 $ \ tyvars' ->
541     rnHsTypeFVs syn_doc ty                      `thenM` \ (ty', fvs) ->
542     returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars', 
543                         tcdSynRhs = ty'},
544              delFVs (map hsLTyVarName tyvars') fvs)
545   where
546     syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
547
548 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname, 
549                        tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs, 
550                        tcdMeths = mbinds})
551   = lookupLocatedTopBndrRn cname                `thenM` \ cname' ->
552
553         -- Tyvars scope over superclass context and method signatures
554     bindTyVarsRn cls_doc tyvars                 ( \ tyvars' ->
555         rnContext cls_doc context       `thenM` \ context' ->
556         rnFds cls_doc fds               `thenM` \ fds' ->
557         renameSigs sigs                 `thenM` \ sigs' ->
558         returnM   (tyvars', context', fds', sigs')
559     )   `thenM` \ (tyvars', context', fds', sigs') ->
560
561         -- Check the signatures
562         -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
563     let
564         sig_rdr_names_w_locs   = [op | L _ (Sig op _) <- sigs]
565     in
566     checkDupNames sig_doc sig_rdr_names_w_locs  `thenM_` 
567     checkSigs okClsDclSig sigs'                         `thenM_`
568         -- Typechecker is responsible for checking that we only
569         -- give default-method bindings for things in this class.
570         -- The renamer *could* check this for class decls, but can't
571         -- for instance decls.
572
573         -- The newLocals call is tiresome: given a generic class decl
574         --      class C a where
575         --        op :: a -> a
576         --        op {| x+y |} (Inl a) = ...
577         --        op {| x+y |} (Inr b) = ...
578         --        op {| a*b |} (a*b)   = ...
579         -- we want to name both "x" tyvars with the same unique, so that they are
580         -- easy to group together in the typechecker.  
581     extendTyVarEnvForMethodBinds tyvars' (
582          getLocalRdrEnv                                 `thenM` \ name_env ->
583          let
584              meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
585              gen_rdr_tyvars_w_locs = 
586                 [ tv | tv <- extractGenericPatTyVars mbinds,
587                       not (unLoc tv `elemLocalRdrEnv` name_env) ]
588          in
589          checkDupNames meth_doc meth_rdr_names_w_locs   `thenM_`
590          newLocalsRn gen_rdr_tyvars_w_locs      `thenM` \ gen_tyvars ->
591          rnMethodBinds (unLoc cname') gen_tyvars mbinds
592     ) `thenM` \ (mbinds', meth_fvs) ->
593
594     returnM (ClassDecl { tcdCtxt = context', tcdLName = cname', tcdTyVars = tyvars',
595                          tcdFDs = fds', tcdSigs = sigs', tcdMeths = mbinds'},
596              delFVs (map hsLTyVarName tyvars')  $
597              extractHsCtxtTyNames context'          `plusFV`
598              plusFVs (map extractFunDepNames (map unLoc fds'))  `plusFV`
599              hsSigsFVs sigs'                        `plusFV`
600              meth_fvs)
601   where
602     meth_doc = text "In the default-methods for class"  <+> ppr cname
603     cls_doc  = text "In the declaration for class"      <+> ppr cname
604     sig_doc  = text "In the signatures for class"       <+> ppr cname
605 \end{code}
606
607 %*********************************************************
608 %*                                                      *
609 \subsection{Support code for type/data declarations}
610 %*                                                      *
611 %*********************************************************
612
613 \begin{code}
614 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
615 rnConDecls tycon condecls
616   =     -- Check that there's at least one condecl,
617         -- or else we're reading an interface file, or -fglasgow-exts
618     (if null condecls then
619         doptM Opt_GlasgowExts   `thenM` \ glaExts ->
620         checkErr glaExts (emptyConDeclsErr tycon)
621      else returnM ()
622     )                                           `thenM_` 
623     mappM (wrapLocM rnConDecl) condecls
624
625 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
626 rnConDecl (ConDecl name tvs cxt details)
627   = addLocM checkConName name           `thenM_` 
628     lookupLocatedTopBndrRn name         `thenM` \ new_name ->
629
630     bindTyVarsRn doc tvs                $ \ new_tyvars ->
631     rnContext doc cxt                   `thenM` \ new_context ->
632     rnConDetails doc details            `thenM` \ new_details -> 
633     returnM (ConDecl new_name new_tyvars new_context new_details)
634   where
635     doc = text "In the definition of data constructor" <+> quotes (ppr name)
636
637 rnConDecl (GadtDecl name ty) 
638   = addLocM checkConName name           `thenM_` 
639     lookupLocatedTopBndrRn name         `thenM` \ new_name ->
640     rnHsSigType doc ty                  `thenM` \ new_ty ->
641     returnM (GadtDecl new_name new_ty)
642   where
643     doc = text "In the definition of data constructor" <+> quotes (ppr name)
644
645 rnConDetails doc (PrefixCon tys)
646   = mappM (rnLHsType doc) tys   `thenM` \ new_tys  ->
647     returnM (PrefixCon new_tys)
648
649 rnConDetails doc (InfixCon ty1 ty2)
650   = rnLHsType doc ty1           `thenM` \ new_ty1 ->
651     rnLHsType doc ty2           `thenM` \ new_ty2 ->
652     returnM (InfixCon new_ty1 new_ty2)
653
654 rnConDetails doc (RecCon fields)
655   = checkDupNames doc field_names       `thenM_`
656     mappM (rnField doc) fields          `thenM` \ new_fields ->
657     returnM (RecCon new_fields)
658   where
659     field_names = [fld | (fld, _) <- fields]
660
661 rnField doc (name, ty)
662   = lookupLocatedTopBndrRn name `thenM` \ new_name ->
663     rnLHsType doc ty            `thenM` \ new_ty ->
664     returnM (new_name, new_ty) 
665
666 -- This data decl will parse OK
667 --      data T = a Int
668 -- treating "a" as the constructor.
669 -- It is really hard to make the parser spot this malformation.
670 -- So the renamer has to check that the constructor is legal
671 --
672 -- We can get an operator as the constructor, even in the prefix form:
673 --      data T = :% Int Int
674 -- from interface files, which always print in prefix form
675
676 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
677
678 badDataCon name
679    = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
680
681 emptyConDeclsErr tycon
682   = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
683          nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]
684 \end{code}
685
686
687 %*********************************************************
688 %*                                                      *
689 \subsection{Support code to rename types}
690 %*                                                      *
691 %*********************************************************
692
693 \begin{code}
694 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
695
696 rnFds doc fds
697   = mappM (wrapLocM rn_fds) fds
698   where
699     rn_fds (tys1, tys2)
700       = rnHsTyVars doc tys1             `thenM` \ tys1' ->
701         rnHsTyVars doc tys2             `thenM` \ tys2' ->
702         returnM (tys1', tys2')
703
704 rnHsTyVars doc tvs  = mappM (rnHsTyvar doc) tvs
705 rnHsTyvar doc tyvar = lookupOccRn tyvar
706 \end{code}
707
708
709 %*********************************************************
710 %*                                                      *
711                 Splices
712 %*                                                      *
713 %*********************************************************
714
715 \begin{code}
716 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
717 rnSplice (HsSplice n expr)
718   = checkTH expr "splice"       `thenM_`
719     getSrcSpanM                 `thenM` \ loc ->
720     newLocalsRn [L loc n]       `thenM` \ [n'] ->
721     rnLExpr expr                `thenM` \ (expr', fvs) ->
722     returnM (HsSplice n' expr', fvs)
723 \end{code}