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 )
  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   = addSrcSpan 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   = lookupLocatedTopBndrRn tycon                `thenM` \ tycon' ->
 492     bindTyVarsRn data_doc tyvars                $ \ tyvars' ->
 493     rnContext data_doc context                  `thenM` \ context' ->
 494     rn_derivs derivs                            `thenM` \ (derivs', deriv_fvs) ->
 495     checkDupNames data_doc con_names    `thenM_`
 496     rnConDecls (unLoc tycon') condecls  `thenM` \ condecls' ->
 497     returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdLName = tycon',
 498                      tcdTyVars = tyvars', tcdCons = condecls',
 499                      tcdDerivs = derivs'},
 500              delFVs (map hsLTyVarName tyvars')  $
 501              extractHsCtxtTyNames context'      `plusFV`
 502              plusFVs (map conDeclFVs condecls') `plusFV`
 503              deriv_fvs)
 504   where
 505     data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
 506     con_names = [ n | L _ (ConDecl n _ _ _) <- condecls ]
 507
 508     rn_derivs Nothing   = returnM (Nothing, emptyFVs)
 509     rn_derivs (Just ds) = rnLHsTypes data_doc ds        `thenM` \ ds' ->
 510                           returnM (Just ds', extractHsTyNames_s ds')
 511
 512 rnTyClDecl (TySynonym {tcdLName = name, tcdTyVars = tyvars, tcdSynRhs = ty})
 513   = lookupLocatedTopBndrRn name                 `thenM` \ name' ->
 514     bindTyVarsRn syn_doc tyvars                 $ \ tyvars' ->
 515     rnHsTypeFVs syn_doc ty                      `thenM` \ (ty', fvs) ->
 516     returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
 517                         tcdSynRhs = ty'},
 518              delFVs (map hsLTyVarName tyvars') fvs)
 519   where
 520     syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
 521
 522 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
 523                        tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
 524                        tcdMeths = mbinds})
 525   = lookupLocatedTopBndrRn cname                `thenM` \ cname' ->
 526
 527         -- Tyvars scope over superclass context and method signatures
 528     bindTyVarsRn cls_doc tyvars                 ( \ tyvars' ->
 529         rnContext cls_doc context       `thenM` \ context' ->
 530         rnFds cls_doc fds               `thenM` \ fds' ->
 531         renameSigs sigs                 `thenM` \ sigs' ->
 532         returnM   (tyvars', context', fds', sigs')
 533     )   `thenM` \ (tyvars', context', fds', sigs') ->
 534
 535         -- Check the signatures
 536         -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
 537     let
 538         sig_rdr_names_w_locs   = [op | L _ (Sig op _) <- sigs]
 539     in
 540     checkDupNames sig_doc sig_rdr_names_w_locs  `thenM_`
 541     checkSigs okClsDclSig sigs'                         `thenM_`
 542         -- Typechecker is responsible for checking that we only
 543         -- give default-method bindings for things in this class.
 544         -- The renamer *could* check this for class decls, but can't
 545         -- for instance decls.
 546
 547         -- The newLocals call is tiresome: given a generic class decl
 548         --      class C a where
 549         --        op :: a -> a
 550         --        op {| x+y |} (Inl a) = ...
 551         --        op {| x+y |} (Inr b) = ...
 552         --        op {| a*b |} (a*b)   = ...
 553         -- we want to name both "x" tyvars with the same unique, so that they are
 554         -- easy to group together in the typechecker.
 555     extendTyVarEnvForMethodBinds tyvars' (
 556          getLocalRdrEnv                                 `thenM` \ name_env ->
 557          let
 558              meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
 559              gen_rdr_tyvars_w_locs =
 560                 [ tv | tv <- extractGenericPatTyVars mbinds,
 561                       not (unLoc tv `elemLocalRdrEnv` name_env) ]
 562          in
 563          checkDupNames meth_doc meth_rdr_names_w_locs   `thenM_`
 564          newLocalsRn gen_rdr_tyvars_w_locs      `thenM` \ gen_tyvars ->
 565          rnMethodBinds (unLoc cname') gen_tyvars mbinds
 566     ) `thenM` \ (mbinds', meth_fvs) ->
 567
 568     returnM (ClassDecl { tcdCtxt = context', tcdLName = cname', tcdTyVars = tyvars',
 569                          tcdFDs = fds', tcdSigs = sigs', tcdMeths = mbinds'},
 570              delFVs (map hsLTyVarName tyvars')  $
 571              extractHsCtxtTyNames context'          `plusFV`
 572              plusFVs (map extractFunDepNames (map unLoc fds'))  `plusFV`
 573              hsSigsFVs sigs'                        `plusFV`
 574              meth_fvs)
 575   where
 576     meth_doc = text "In the default-methods for class"  <+> ppr cname
 577     cls_doc  = text "In the declaration for class"      <+> ppr cname
 578     sig_doc  = text "In the signatures for class"       <+> ppr cname
 579 \end{code}
 580
 581 %*********************************************************
 582 %*                                                      *
 583 \subsection{Support code for type/data declarations}
 584 %*                                                      *
 585 %*********************************************************
 586
 587 \begin{code}
 588 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
 589 rnConDecls tycon condecls
 590   =     -- Check that there's at least one condecl,
 591         -- or else we're reading an interface file, or -fglasgow-exts
 592     (if null condecls then
 593         doptM Opt_GlasgowExts   `thenM` \ glaExts ->
 594         checkErr glaExts (emptyConDeclsErr tycon)
 595      else returnM ()
 596     )                                           `thenM_`
 597     mappM (wrapLocM rnConDecl) condecls
 598
 599 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
 600 rnConDecl (ConDecl name tvs cxt details)
 601   = addLocM checkConName name           `thenM_`
 602     lookupLocatedTopBndrRn name         `thenM` \ new_name ->
 603
 604     bindTyVarsRn doc tvs                $ \ new_tyvars ->
 605     rnContext doc cxt                   `thenM` \ new_context ->
 606     rnConDetails doc details            `thenM` \ new_details ->
 607     returnM (ConDecl new_name new_tyvars new_context new_details)
 608   where
 609     doc = text "In the definition of data constructor" <+> quotes (ppr name)
 610
 611 rnConDetails doc (PrefixCon tys)
 612   = mappM (rnLBangTy doc) tys   `thenM` \ new_tys  ->
 613     returnM (PrefixCon new_tys)
 614
 615 rnConDetails doc (InfixCon ty1 ty2)
 616   = rnLBangTy doc ty1           `thenM` \ new_ty1 ->
 617     rnLBangTy doc ty2           `thenM` \ new_ty2 ->
 618     returnM (InfixCon new_ty1 new_ty2)
 619
 620 rnConDetails doc (RecCon fields)
 621   = checkDupNames doc field_names       `thenM_`
 622     mappM (rnField doc) fields          `thenM` \ new_fields ->
 623     returnM (RecCon new_fields)
 624   where
 625     field_names = [fld | (fld, _) <- fields]
 626
 627 rnField doc (name, ty)
 628   = lookupLocatedTopBndrRn name `thenM` \ new_name ->
 629     rnLBangTy doc ty            `thenM` \ new_ty ->
 630     returnM (new_name, new_ty)
 631
 632 rnLBangTy doc = wrapLocM (rnBangTy doc)
 633
 634 rnBangTy doc (BangType s ty)
 635   = rnLHsType doc ty            `thenM` \ new_ty ->
 636     returnM (BangType s new_ty)
 637
 638 -- This data decl will parse OK
 639 --      data T = a Int
 640 -- treating "a" as the constructor.
 641 -- It is really hard to make the parser spot this malformation.
 642 -- So the renamer has to check that the constructor is legal
 643 --
 644 -- We can get an operator as the constructor, even in the prefix form:
 645 --      data T = :% Int Int
 646 -- from interface files, which always print in prefix form
 647
 648 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
 649
 650 badDataCon name
 651    = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
 652
 653 emptyConDeclsErr tycon
 654   = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
 655          nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]
 656 \end{code}
 657
 658
 659 %*********************************************************
 660 %*                                                      *
 661 \subsection{Support code to rename types}
 662 %*                                                      *
 663 %*********************************************************
 664
 665 \begin{code}
 666 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
 667
 668 rnFds doc fds
 669   = mappM (wrapLocM rn_fds) fds
 670   where
 671     rn_fds (tys1, tys2)
 672       = rnHsTyVars doc tys1             `thenM` \ tys1' ->
 673         rnHsTyVars doc tys2             `thenM` \ tys2' ->
 674         returnM (tys1', tys2')
 675
 676 rnHsTyVars doc tvs  = mappM (rnHsTyvar doc) tvs
 677 rnHsTyvar doc tyvar = lookupOccRn tyvar
 678 \end{code}
 679
 680
 681 %*********************************************************
 682 %*                                                      *
 683                 Splices
 684 %*                                                      *
 685 %*********************************************************
 686
 687 \begin{code}
 688 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
 689 rnSplice (HsSplice n expr)
 690   = checkTH expr "splice"       `thenM_`
 691     getSrcSpanM                 `thenM` \ loc ->
 692     newLocalsRn [L loc n]       `thenM` \ [n'] ->
 693     rnLExpr expr                `thenM` \ (expr', fvs) ->
 694     returnM (HsSplice n' expr', fvs)
 695 \end{code}