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         rnSplice, checkTH
  11     ) where
  12
  13 #include "HsVersions.h"
  14
  15 import {-# SOURCE #-} RnExpr( rnLExpr )
  16
  17 import HsSyn
  18 import RdrName          ( RdrName, isRdrDataCon, elemLocalRdrEnv, globalRdrEnvElts,
  19                           GlobalRdrElt(..), isLocalGRE )
  20 import RdrHsSyn         ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
  21 import RnHsSyn
  22 import RnTypes          ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
  23 import RnBinds          ( rnTopBinds, rnMethodBinds, renameSigs, mkSigTvFn )
  24 import RnEnv            ( lookupLocalDataTcNames,
  25                           lookupLocatedTopBndrRn, lookupLocatedOccRn,
  26                           lookupOccRn, newLocalsRn,
  27                           bindLocatedLocalsFV, bindPatSigTyVarsFV,
  28                           bindTyVarsRn, extendTyVarEnvFVRn,
  29                           bindLocalNames, checkDupNames, mapFvRn
  30                         )
  31 import TcRnMonad
  32
  33 import HscTypes         ( FixityEnv, FixItem(..),
  34                           Deprecations, Deprecs(..), DeprecTxt, plusDeprecs )
  35 import Class            ( FunDep )
  36 import Name             ( Name, nameOccName )
  37 import NameSet
  38 import NameEnv
  39 import OccName          ( occEnvElts )
  40 import Outputable
  41 import SrcLoc           ( Located(..), unLoc, noLoc )
  42 import DynFlags ( DynFlag(..) )
  43 import Maybes           ( seqMaybe )
  44 import Maybe            ( isNothing )
  45 import BasicTypes       ( Boxity(..) )
  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  = val_decls,
  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         rn_fix_decls <- rnSrcFixityDecls fix_decls ;
  84         fix_env <- rnSrcFixityDeclsEnv rn_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 val_decls ;
  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  = rn_fix_decls,
 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                 -- Note: src_dus will contain *uses* for locally-defined types
 125                 -- and classes, but no *defs* for them.  (Because rnTyClDecl
 126                 -- returns only the uses.)  This is a little
 127                 -- surprising but it doesn't actually matter at all.
 128         } ;
 129
 130         traceRn (text "finish rnSrc" <+> ppr rn_group) ;
 131         traceRn (text "finish Dus" <+> ppr src_dus ) ;
 132         tcg_env <- getGblEnv ;
 133         return (tcg_env `addTcgDUs` src_dus, rn_group)
 134     }}}
 135
 136 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
 137 rnTyClDecls tycl_decls = do
 138   (decls', fvs) <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls
 139   return decls'
 140
 141 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
 142 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
 143 \end{code}
 144
 145
 146 %*********************************************************
 147 %*                                                       *
 148         Source-code fixity declarations
 149 %*                                                       *
 150 %*********************************************************
 151
 152 \begin{code}
 153 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
 154 rnSrcFixityDecls fix_decls
 155     = do fix_decls <- mapM rnFixityDecl fix_decls
 156          return (concat fix_decls)
 157
 158 rnFixityDecl :: LFixitySig RdrName -> RnM [LFixitySig Name]
 159 rnFixityDecl (L loc (FixitySig (L nameLoc rdr_name) fixity))
 160     = setSrcSpan nameLoc $
 161         -- GHC extension: look up both the tycon and data con
 162         -- for con-like things
 163         -- If neither are in scope, report an error; otherwise
 164         -- add both to the fixity env
 165       do names <- lookupLocalDataTcNames rdr_name
 166          return [ L loc (FixitySig (L nameLoc name) fixity)
 167                       | name <- names ]
 168
 169 rnSrcFixityDeclsEnv :: [LFixitySig Name] -> RnM FixityEnv
 170 rnSrcFixityDeclsEnv fix_decls
 171   = getGblEnv                                   `thenM` \ gbl_env ->
 172     foldlM rnFixityDeclEnv (tcg_fix_env gbl_env)
 173             fix_decls                                   `thenM` \ fix_env ->
 174     traceRn (text "fixity env" <+> pprFixEnv fix_env)   `thenM_`
 175     returnM fix_env
 176
 177 rnFixityDeclEnv :: FixityEnv -> LFixitySig Name -> RnM FixityEnv
 178 rnFixityDeclEnv fix_env (L loc (FixitySig (L nameLoc name) fixity))
 179   = case lookupNameEnv fix_env name of
 180       Just (FixItem _ _ loc')
 181           -> do addLocErr (L nameLoc name) (dupFixityDecl loc')
 182                 return fix_env
 183       Nothing
 184           -> return (extendNameEnv fix_env name fix_item)
 185     where fix_item = FixItem (nameOccName name) fixity nameLoc
 186
 187 pprFixEnv :: FixityEnv -> SDoc
 188 pprFixEnv env
 189   = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
 190                   (nameEnvElts env)
 191
 192 dupFixityDecl loc rdr_name
 193   = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
 194           ptext SLIT("also at ") <+> ppr loc
 195         ]
 196 \end{code}
 197
 198
 199 %*********************************************************
 200 %*                                                       *
 201         Source-code deprecations declarations
 202 %*                                                       *
 203 %*********************************************************
 204
 205 For deprecations, all we do is check that the names are in scope.
 206 It's only imported deprecations, dealt with in RnIfaces, that we
 207 gather them together.
 208
 209 \begin{code}
 210 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
 211 rnSrcDeprecDecls []
 212   = returnM NoDeprecs
 213
 214 rnSrcDeprecDecls decls
 215   = mappM (addLocM rn_deprec) decls     `thenM` \ pairs_s ->
 216     returnM (DeprecSome (mkNameEnv (concat pairs_s)))
 217  where
 218    rn_deprec (Deprecation rdr_name txt)
 219      = lookupLocalDataTcNames rdr_name  `thenM` \ names ->
 220        returnM [(name, (nameOccName name, txt)) | name <- names]
 221
 222 checkModDeprec :: Maybe DeprecTxt -> Deprecations
 223 -- Check for a module deprecation; done once at top level
 224 checkModDeprec Nothing    = NoDeprecs
 225 checkModDeprec (Just txt) = DeprecAll txt
 226 \end{code}
 227
 228 %*********************************************************
 229 %*                                                      *
 230 \subsection{Source code declarations}
 231 %*                                                      *
 232 %*********************************************************
 233
 234 \begin{code}
 235 rnDefaultDecl (DefaultDecl tys)
 236   = mapFvRn (rnHsTypeFVs doc_str) tys   `thenM` \ (tys', fvs) ->
 237     returnM (DefaultDecl tys', fvs)
 238   where
 239     doc_str = text "In a `default' declaration"
 240 \end{code}
 241
 242 %*********************************************************
 243 %*                                                      *
 244 \subsection{Foreign declarations}
 245 %*                                                      *
 246 %*********************************************************
 247
 248 \begin{code}
 249 rnHsForeignDecl (ForeignImport name ty spec)
 250   = lookupLocatedTopBndrRn name         `thenM` \ name' ->
 251     rnHsTypeFVs (fo_decl_msg name) ty   `thenM` \ (ty', fvs) ->
 252     returnM (ForeignImport name' ty' spec, fvs)
 253
 254 rnHsForeignDecl (ForeignExport name ty spec)
 255   = lookupLocatedOccRn name             `thenM` \ name' ->
 256     rnHsTypeFVs (fo_decl_msg name) ty   `thenM` \ (ty', fvs) ->
 257     returnM (ForeignExport name' ty' spec, fvs )
 258         -- NB: a foreign export is an *occurrence site* for name, so
 259         --     we add it to the free-variable list.  It might, for example,
 260         --     be imported from another module
 261
 262 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
 263 \end{code}
 264
 265
 266 %*********************************************************
 267 %*                                                      *
 268 \subsection{Instance declarations}
 269 %*                                                      *
 270 %*********************************************************
 271
 272 \begin{code}
 273 rnSrcInstDecl (InstDecl inst_ty mbinds uprags)
 274         -- Used for both source and interface file decls
 275   = rnHsSigType (text "an instance decl") inst_ty       `thenM` \ inst_ty' ->
 276
 277         -- Rename the bindings
 278         -- The typechecker (not the renamer) checks that all
 279         -- the bindings are for the right class
 280     let
 281         meth_doc    = text "In the bindings in an instance declaration"
 282         meth_names  = collectHsBindLocatedBinders mbinds
 283         (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
 284     in
 285     checkDupNames meth_doc meth_names   `thenM_`
 286     extendTyVarEnvForMethodBinds inst_tyvars (
 287         -- (Slightly strangely) the forall-d tyvars scope over
 288         -- the method bindings too
 289         rnMethodBinds cls (\n->[])      -- No scoped tyvars
 290                       [] mbinds
 291     )                                           `thenM` \ (mbinds', meth_fvs) ->
 292         -- Rename the prags and signatures.
 293         -- Note that the type variables are not in scope here,
 294         -- so that      instance Eq a => Eq (T a) where
 295         --                      {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
 296         -- works OK.
 297         --
 298         -- But the (unqualified) method names are in scope
 299     let
 300         binders = collectHsBindBinders mbinds'
 301         ok_sig  = okInstDclSig (mkNameSet binders)
 302     in
 303     bindLocalNames binders (renameSigs ok_sig uprags)   `thenM` \ uprags' ->
 304
 305     returnM (InstDecl inst_ty' mbinds' uprags',
 306              meth_fvs `plusFV` hsSigsFVs uprags'
 307                       `plusFV` extractHsTyNames inst_ty')
 308 \end{code}
 309
 310 For the method bindings in class and instance decls, we extend the
 311 type variable environment iff -fglasgow-exts
 312
 313 \begin{code}
 314 extendTyVarEnvForMethodBinds tyvars thing_inside
 315   = doptM Opt_GlasgowExts                       `thenM` \ opt_GlasgowExts ->
 316     if opt_GlasgowExts then
 317         extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
 318     else
 319         thing_inside
 320 \end{code}
 321
 322
 323 %*********************************************************
 324 %*                                                      *
 325 \subsection{Rules}
 326 %*                                                      *
 327 %*********************************************************
 328
 329 \begin{code}
 330 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
 331   = bindPatSigTyVarsFV (collectRuleBndrSigTys vars)     $
 332
 333     bindLocatedLocalsFV doc (map get_var vars)          $ \ ids ->
 334     mapFvRn rn_var (vars `zip` ids)             `thenM` \ (vars', fv_vars) ->
 335
 336     rnLExpr lhs                                 `thenM` \ (lhs', fv_lhs') ->
 337     rnLExpr rhs                                 `thenM` \ (rhs', fv_rhs') ->
 338
 339     checkValidRule rule_name ids lhs' fv_lhs'   `thenM_`
 340
 341     returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
 342              fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
 343   where
 344     doc = text "In the transformation rule" <+> ftext rule_name
 345
 346     get_var (RuleBndr v)      = v
 347     get_var (RuleBndrSig v _) = v
 348
 349     rn_var (RuleBndr (L loc v), id)
 350         = returnM (RuleBndr (L loc id), emptyFVs)
 351     rn_var (RuleBndrSig (L loc v) t, id)
 352         = rnHsTypeFVs doc t     `thenM` \ (t', fvs) ->
 353           returnM (RuleBndrSig (L loc id) t', fvs)
 354
 355 badRuleVar name var
 356   = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
 357          ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
 358                 ptext SLIT("does not appear on left hand side")]
 359 \end{code}
 360
 361 Note [Rule LHS validity checking]
 362 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 363 Check the shape of a transformation rule LHS.  Currently we only allow
 364 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
 365 @forall@'d variables.
 366
 367 We used restrict the form of the 'ei' to prevent you writing rules
 368 with LHSs with a complicated desugaring (and hence unlikely to match);
 369 (e.g. a case expression is not allowed: too elaborate.)
 370
 371 But there are legitimate non-trivial args ei, like sections and
 372 lambdas.  So it seems simmpler not to check at all, and that is why
 373 check_e is commented out.
 374
 375 \begin{code}
 376 checkValidRule rule_name ids lhs' fv_lhs'
 377   = do  {       -- Check for the form of the LHS
 378           case (validRuleLhs ids lhs') of
 379                 Nothing  -> return ()
 380                 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
 381
 382                 -- Check that LHS vars are all bound
 383         ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
 384         ; mappM (addErr . badRuleVar rule_name) bad_vars }
 385
 386 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
 387 -- Nothing => OK
 388 -- Just e  => Not ok, and e is the offending expression
 389 validRuleLhs foralls lhs
 390   = checkl lhs
 391   where
 392     checkl (L loc e) = check e
 393
 394     check (OpApp e1 op _ e2)              = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
 395     check (HsApp e1 e2)                   = checkl e1 `seqMaybe` checkl_e e2
 396     check (HsVar v) | v `notElem` foralls = Nothing
 397     check other                           = Just other  -- Failure
 398
 399         -- Check an argument
 400     checkl_e (L loc e) = Nothing        -- Was (check_e e); see Note [Rule LHS validity checking]
 401
 402 {-      Commented out; see Note [Rule LHS validity checking] above
 403     check_e (HsVar v)     = Nothing
 404     check_e (HsPar e)     = checkl_e e
 405     check_e (HsLit e)     = Nothing
 406     check_e (HsOverLit e) = Nothing
 407
 408     check_e (OpApp e1 op _ e2)   = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
 409     check_e (HsApp e1 e2)        = checkl_e e1 `seqMaybe` checkl_e e2
 410     check_e (NegApp e _)         = checkl_e e
 411     check_e (ExplicitList _ es)  = checkl_es es
 412     check_e (ExplicitTuple es _) = checkl_es es
 413     check_e other                = Just other   -- Fails
 414
 415     checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
 416 -}
 417
 418 badRuleLhsErr name lhs bad_e
 419   = sep [ptext SLIT("Rule") <+> ftext name <> colon,
 420          nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
 421                        ptext SLIT("in left-hand side:") <+> ppr lhs])]
 422     $$
 423     ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
 424 \end{code}
 425
 426
 427 %*********************************************************
 428 %*                                                      *
 429 \subsection{Type, class and iface sig declarations}
 430 %*                                                      *
 431 %*********************************************************
 432
 433 @rnTyDecl@ uses the `global name function' to create a new type
 434 declaration in which local names have been replaced by their original
 435 names, reporting any unknown names.
 436
 437 Renaming type variables is a pain. Because they now contain uniques,
 438 it is necessary to pass in an association list which maps a parsed
 439 tyvar to its @Name@ representation.
 440 In some cases (type signatures of values),
 441 it is even necessary to go over the type first
 442 in order to get the set of tyvars used by it, make an assoc list,
 443 and then go over it again to rename the tyvars!
 444 However, we can also do some scoping checks at the same time.
 445
 446 \begin{code}
 447 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
 448   = lookupLocatedTopBndrRn name         `thenM` \ name' ->
 449     returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
 450              emptyFVs)
 451
 452 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = tycon,
 453                     tcdTyVars = tyvars, tcdCons = condecls,
 454                     tcdKindSig = sig, tcdDerivs = derivs})
 455   | is_vanilla  -- Normal Haskell data type decl
 456   = ASSERT( isNothing sig )     -- In normal H98 form, kind signature on the
 457                                 -- data type is syntactically illegal
 458     bindTyVarsRn data_doc tyvars                $ \ tyvars' ->
 459     do  { tycon' <- lookupLocatedTopBndrRn tycon
 460         ; context' <- rnContext data_doc context
 461         ; (derivs', deriv_fvs) <- rn_derivs derivs
 462         ; checkDupNames data_doc con_names
 463         ; condecls' <- rnConDecls (unLoc tycon') condecls
 464         ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdLName = tycon',
 465                            tcdTyVars = tyvars', tcdKindSig = Nothing, tcdCons = condecls',
 466                            tcdDerivs = derivs'},
 467                    delFVs (map hsLTyVarName tyvars')    $
 468                    extractHsCtxtTyNames context'        `plusFV`
 469                    plusFVs (map conDeclFVs condecls') `plusFV`
 470                    deriv_fvs) }
 471
 472   | otherwise   -- GADT
 473   = do  { tycon' <- lookupLocatedTopBndrRn tycon
 474         ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
 475         ; tyvars' <- bindTyVarsRn data_doc tyvars
 476                                   (\ tyvars' -> return tyvars')
 477                 -- For GADTs, the type variables in the declaration
 478                 -- do not scope over the constructor signatures
 479                 --      data T a where { T1 :: forall b. b-> b }
 480         ; (derivs', deriv_fvs) <- rn_derivs derivs
 481         ; checkDupNames data_doc con_names
 482         ; condecls' <- rnConDecls (unLoc tycon') condecls
 483         ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [], tcdLName = tycon',
 484                            tcdTyVars = tyvars', tcdCons = condecls', tcdKindSig = sig,
 485                            tcdDerivs = derivs'},
 486                    plusFVs (map conDeclFVs condecls') `plusFV` deriv_fvs) }
 487
 488   where
 489     is_vanilla = case condecls of       -- Yuk
 490                      []                    -> True
 491                      L _ (ConDecl { con_res = ResTyH98 }) : _  -> True
 492                      other                 -> False
 493
 494     data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
 495     con_names = map con_names_helper condecls
 496
 497     con_names_helper (L _ c) = con_name c
 498
 499     rn_derivs Nothing   = returnM (Nothing, emptyFVs)
 500     rn_derivs (Just ds) = rnLHsTypes data_doc ds        `thenM` \ ds' ->
 501                           returnM (Just ds', extractHsTyNames_s ds')
 502
 503 rnTyClDecl (TySynonym {tcdLName = name, tcdTyVars = tyvars, tcdSynRhs = ty})
 504   = lookupLocatedTopBndrRn name                 `thenM` \ name' ->
 505     bindTyVarsRn syn_doc tyvars                 $ \ tyvars' ->
 506     rnHsTypeFVs syn_doc ty                      `thenM` \ (ty', fvs) ->
 507     returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
 508                         tcdSynRhs = ty'},
 509              delFVs (map hsLTyVarName tyvars') fvs)
 510   where
 511     syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
 512
 513 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
 514                        tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
 515                        tcdMeths = mbinds})
 516   = lookupLocatedTopBndrRn cname                `thenM` \ cname' ->
 517
 518         -- Tyvars scope over superclass context and method signatures
 519     bindTyVarsRn cls_doc tyvars                 ( \ tyvars' ->
 520         rnContext cls_doc context       `thenM` \ context' ->
 521         rnFds cls_doc fds               `thenM` \ fds' ->
 522         renameSigs okClsDclSig sigs     `thenM` \ sigs' ->
 523         returnM   (tyvars', context', fds', sigs')
 524     )   `thenM` \ (tyvars', context', fds', sigs') ->
 525
 526         -- Check the signatures
 527         -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
 528     let
 529         sig_rdr_names_w_locs   = [op | L _ (TypeSig op _) <- sigs]
 530     in
 531     checkDupNames sig_doc sig_rdr_names_w_locs  `thenM_`
 532         -- Typechecker is responsible for checking that we only
 533         -- give default-method bindings for things in this class.
 534         -- The renamer *could* check this for class decls, but can't
 535         -- for instance decls.
 536
 537         -- The newLocals call is tiresome: given a generic class decl
 538         --      class C a where
 539         --        op :: a -> a
 540         --        op {| x+y |} (Inl a) = ...
 541         --        op {| x+y |} (Inr b) = ...
 542         --        op {| a*b |} (a*b)   = ...
 543         -- we want to name both "x" tyvars with the same unique, so that they are
 544         -- easy to group together in the typechecker.
 545     extendTyVarEnvForMethodBinds tyvars' (
 546          getLocalRdrEnv                                 `thenM` \ name_env ->
 547          let
 548              meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
 549              gen_rdr_tyvars_w_locs =
 550                 [ tv | tv <- extractGenericPatTyVars mbinds,
 551                       not (unLoc tv `elemLocalRdrEnv` name_env) ]
 552          in
 553          checkDupNames meth_doc meth_rdr_names_w_locs   `thenM_`
 554          newLocalsRn gen_rdr_tyvars_w_locs      `thenM` \ gen_tyvars ->
 555          rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds
 556     ) `thenM` \ (mbinds', meth_fvs) ->
 557
 558     returnM (ClassDecl { tcdCtxt = context', tcdLName = cname', tcdTyVars = tyvars',
 559                          tcdFDs = fds', tcdSigs = sigs', tcdMeths = mbinds'},
 560              delFVs (map hsLTyVarName tyvars')  $
 561              extractHsCtxtTyNames context'          `plusFV`
 562              plusFVs (map extractFunDepNames (map unLoc fds'))  `plusFV`
 563              hsSigsFVs sigs'                        `plusFV`
 564              meth_fvs)
 565   where
 566     meth_doc = text "In the default-methods for class"  <+> ppr cname
 567     cls_doc  = text "In the declaration for class"      <+> ppr cname
 568     sig_doc  = text "In the signatures for class"       <+> ppr cname
 569
 570 badGadtStupidTheta tycon
 571   = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
 572           ptext SLIT("(You can put a context on each contructor, though.)")]
 573 \end{code}
 574
 575 %*********************************************************
 576 %*                                                      *
 577 \subsection{Support code for type/data declarations}
 578 %*                                                      *
 579 %*********************************************************
 580
 581 \begin{code}
 582 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
 583 rnConDecls tycon condecls
 584   = mappM (wrapLocM rnConDecl) condecls
 585
 586 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
 587 rnConDecl (ConDecl name expl tvs cxt details res_ty)
 588   = do  { addLocM checkConName name
 589
 590         ; new_name <- lookupLocatedTopBndrRn name
 591         ; name_env <- getLocalRdrEnv
 592
 593         -- For H98 syntax, the tvs are the existential ones
 594         -- For GADT syntax, the tvs are all the quantified tyvars
 595         -- Hence the 'filter' in the ResTyH98 case only
 596         ; let not_in_scope  = not . (`elemLocalRdrEnv` name_env) . unLoc
 597               arg_tys       = hsConArgs details
 598               implicit_tvs  = case res_ty of
 599                                 ResTyH98 -> filter not_in_scope $
 600                                                 get_rdr_tvs arg_tys
 601                                 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
 602               tvs' = case expl of
 603                         Explicit -> tvs
 604                         Implicit -> userHsTyVarBndrs implicit_tvs
 605
 606         ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
 607         { new_context <- rnContext doc cxt
 608         ; new_details <- rnConDetails doc details
 609         ; (new_details', new_res_ty)  <- rnConResult doc new_details res_ty
 610         ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty) }}
 611   where
 612     doc = text "In the definition of data constructor" <+> quotes (ppr name)
 613     get_rdr_tvs tys  = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
 614
 615 rnConResult _ details ResTyH98 = return (details, ResTyH98)
 616
 617 rnConResult doc details (ResTyGADT ty) = do
 618     ty' <- rnHsSigType doc ty
 619     let (arg_tys, res_ty) = splitHsFunType ty'
 620         -- We can split it up, now the renamer has dealt with fixities
 621     case details of
 622         PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
 623         RecCon fields -> return (details, ResTyGADT ty')
 624         InfixCon {}   -> panic "rnConResult"
 625
 626 rnConDetails doc (PrefixCon tys)
 627   = mappM (rnLHsType doc) tys   `thenM` \ new_tys  ->
 628     returnM (PrefixCon new_tys)
 629
 630 rnConDetails doc (InfixCon ty1 ty2)
 631   = rnLHsType doc ty1           `thenM` \ new_ty1 ->
 632     rnLHsType doc ty2           `thenM` \ new_ty2 ->
 633     returnM (InfixCon new_ty1 new_ty2)
 634
 635 rnConDetails doc (RecCon fields)
 636   = checkDupNames doc field_names       `thenM_`
 637     mappM (rnField doc) fields          `thenM` \ new_fields ->
 638     returnM (RecCon new_fields)
 639   where
 640     field_names = [fld | (fld, _) <- fields]
 641
 642 rnField doc (name, ty)
 643   = lookupLocatedTopBndrRn name `thenM` \ new_name ->
 644     rnLHsType doc ty            `thenM` \ new_ty ->
 645     returnM (new_name, new_ty)
 646
 647 -- This data decl will parse OK
 648 --      data T = a Int
 649 -- treating "a" as the constructor.
 650 -- It is really hard to make the parser spot this malformation.
 651 -- So the renamer has to check that the constructor is legal
 652 --
 653 -- We can get an operator as the constructor, even in the prefix form:
 654 --      data T = :% Int Int
 655 -- from interface files, which always print in prefix form
 656
 657 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
 658
 659 badDataCon name
 660    = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
 661 \end{code}
 662
 663
 664 %*********************************************************
 665 %*                                                      *
 666 \subsection{Support code to rename types}
 667 %*                                                      *
 668 %*********************************************************
 669
 670 \begin{code}
 671 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
 672
 673 rnFds doc fds
 674   = mappM (wrapLocM rn_fds) fds
 675   where
 676     rn_fds (tys1, tys2)
 677       = rnHsTyVars doc tys1             `thenM` \ tys1' ->
 678         rnHsTyVars doc tys2             `thenM` \ tys2' ->
 679         returnM (tys1', tys2')
 680
 681 rnHsTyVars doc tvs  = mappM (rnHsTyvar doc) tvs
 682 rnHsTyvar doc tyvar = lookupOccRn tyvar
 683 \end{code}
 684
 685
 686 %*********************************************************
 687 %*                                                      *
 688                 Splices
 689 %*                                                      *
 690 %*********************************************************
 691
 692 Note [Splices]
 693 ~~~~~~~~~~~~~~
 694 Consider
 695         f = ...
 696         h = ...$(thing "f")...
 697
 698 The splice can expand into literally anything, so when we do dependency
 699 analysis we must assume that it might mention 'f'.  So we simply treat
 700 all locally-defined names as mentioned by any splice.  This is terribly
 701 brutal, but I don't see what else to do.  For example, it'll mean
 702 that every locally-defined thing will appear to be used, so no unused-binding
 703 warnings.  But if we miss the dependency, then we might typecheck 'h' before 'f',
 704 and that will crash the type checker because 'f' isn't in scope.
 705
 706 Currently, I'm not treating a splice as also mentioning every import,
 707 which is a bit inconsistent -- but there are a lot of them.  We might
 708 thereby get some bogus unused-import warnings, but we won't crash the
 709 type checker.  Not very satisfactory really.
 710
 711 \begin{code}
 712 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
 713 rnSplice (HsSplice n expr)
 714   = do  { checkTH expr "splice"
 715         ; loc  <- getSrcSpanM
 716         ; [n'] <- newLocalsRn [L loc n]
 717         ; (expr', fvs) <- rnLExpr expr
 718
 719         -- Ugh!  See Note [Splices] above
 720         ; lcl_rdr <- getLocalRdrEnv
 721         ; gbl_rdr <- getGlobalRdrEnv
 722         ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
 723                                                     isLocalGRE gre]
 724               lcl_names = mkNameSet (occEnvElts lcl_rdr)
 725
 726         ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
 727
 728 #ifdef GHCI
 729 checkTH e what = returnM ()     -- OK
 730 #else
 731 checkTH e what  -- Raise an error in a stage-1 compiler
 732   = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
 733                   ptext SLIT("illegal in a stage-1 compiler"),
 734                   nest 2 (ppr e)])
 735 #endif
 736 \end{code}