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