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