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