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     let
 339         mb_bad = validRuleLhs ids lhs'
 340     in
 341     checkErr (isNothing mb_bad)
 342              (badRuleLhsErr rule_name lhs' mb_bad)      `thenM_`
 343     let
 344         bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
 345     in
 346     mappM (addErr . badRuleVar rule_name) bad_vars      `thenM_`
 347     returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
 348              fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
 349   where
 350     doc = text "In the transformation rule" <+> ftext rule_name
 351
 352     get_var (RuleBndr v)      = v
 353     get_var (RuleBndrSig v _) = v
 354
 355     rn_var (RuleBndr (L loc v), id)
 356         = returnM (RuleBndr (L loc id), emptyFVs)
 357     rn_var (RuleBndrSig (L loc v) t, id)
 358         = rnHsTypeFVs doc t     `thenM` \ (t', fvs) ->
 359           returnM (RuleBndrSig (L loc id) t', fvs)
 360
 361 badRuleVar name var
 362   = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
 363          ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
 364                 ptext SLIT("does not appear on left hand side")]
 365 \end{code}
 366
 367 Note [Rule LHS validity checking]
 368 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 369 Check the shape of a transformation rule LHS.  Currently we only allow
 370 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
 371 @forall@'d variables.
 372
 373 We used restrict the form of the 'ei' to prevent you writing rules
 374 with LHSs with a complicated desugaring (and hence unlikely to match);
 375 (e.g. a case expression is not allowed: too elaborate.)
 376
 377 But there are legitimate non-trivial args ei, like sections and
 378 lambdas.  So it seems simmpler not to check at all, and that is why
 379 check_e is commented out.
 380
 381 \begin{code}
 382 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
 383 -- Nothing => OK
 384 -- Just e  => Not ok, and e is the offending expression
 385 validRuleLhs foralls lhs
 386   = checkl lhs
 387   where
 388     checkl (L loc e) = check e
 389
 390     check (OpApp e1 op _ e2)              = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
 391     check (HsApp e1 e2)                   = checkl e1 `seqMaybe` checkl_e e2
 392     check (HsVar v) | v `notElem` foralls = Nothing
 393     check other                           = Just other  -- Failure
 394
 395         -- Check an argument
 396     checkl_e (L loc e) = Nothing        -- Was (check_e e); see Note [Rule LHS validity checking]
 397
 398 {-      Commented out; see Note [Rule LHS validity checking] above
 399     check_e (HsVar v)     = Nothing
 400     check_e (HsPar e)     = checkl_e e
 401     check_e (HsLit e)     = Nothing
 402     check_e (HsOverLit e) = Nothing
 403
 404     check_e (OpApp e1 op _ e2)   = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
 405     check_e (HsApp e1 e2)        = checkl_e e1 `seqMaybe` checkl_e e2
 406     check_e (NegApp e _)         = checkl_e e
 407     check_e (ExplicitList _ es)  = checkl_es es
 408     check_e (ExplicitTuple es _) = checkl_es es
 409     check_e other                = Just other   -- Fails
 410
 411     checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
 412 -}
 413
 414 badRuleLhsErr name lhs (Just bad_e)
 415   = sep [ptext SLIT("Rule") <+> ftext name <> colon,
 416          nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
 417                        ptext SLIT("in left-hand side:") <+> ppr lhs])]
 418     $$
 419     ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
 420 \end{code}
 421
 422
 423 %*********************************************************
 424 %*                                                      *
 425 \subsection{Type, class and iface sig declarations}
 426 %*                                                      *
 427 %*********************************************************
 428
 429 @rnTyDecl@ uses the `global name function' to create a new type
 430 declaration in which local names have been replaced by their original
 431 names, reporting any unknown names.
 432
 433 Renaming type variables is a pain. Because they now contain uniques,
 434 it is necessary to pass in an association list which maps a parsed
 435 tyvar to its @Name@ representation.
 436 In some cases (type signatures of values),
 437 it is even necessary to go over the type first
 438 in order to get the set of tyvars used by it, make an assoc list,
 439 and then go over it again to rename the tyvars!
 440 However, we can also do some scoping checks at the same time.
 441
 442 \begin{code}
 443 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
 444   = lookupLocatedTopBndrRn name         `thenM` \ name' ->
 445     returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
 446              emptyFVs)
 447
 448 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = tycon,
 449                     tcdTyVars = tyvars, tcdCons = condecls,
 450                     tcdKindSig = sig, tcdDerivs = derivs})
 451   | is_vanilla  -- Normal Haskell data type decl
 452   = ASSERT( isNothing sig )     -- In normal H98 form, kind signature on the
 453                                 -- data type is syntactically illegal
 454     bindTyVarsRn data_doc tyvars                $ \ tyvars' ->
 455     do  { tycon' <- lookupLocatedTopBndrRn tycon
 456         ; context' <- rnContext data_doc context
 457         ; (derivs', deriv_fvs) <- rn_derivs derivs
 458         ; checkDupNames data_doc con_names
 459         ; condecls' <- rnConDecls (unLoc tycon') condecls
 460         ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdLName = tycon',
 461                            tcdTyVars = tyvars', tcdKindSig = Nothing, tcdCons = condecls',
 462                            tcdDerivs = derivs'},
 463                    delFVs (map hsLTyVarName tyvars')    $
 464                    extractHsCtxtTyNames context'        `plusFV`
 465                    plusFVs (map conDeclFVs condecls') `plusFV`
 466                    deriv_fvs) }
 467
 468   | otherwise   -- GADT
 469   = do  { tycon' <- lookupLocatedTopBndrRn tycon
 470         ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
 471         ; tyvars' <- bindTyVarsRn data_doc tyvars
 472                                   (\ tyvars' -> return tyvars')
 473                 -- For GADTs, the type variables in the declaration
 474                 -- do not scope over the constructor signatures
 475                 --      data T a where { T1 :: forall b. b-> b }
 476         ; (derivs', deriv_fvs) <- rn_derivs derivs
 477         ; checkDupNames data_doc con_names
 478         ; condecls' <- rnConDecls (unLoc tycon') condecls
 479         ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [], tcdLName = tycon',
 480                            tcdTyVars = tyvars', tcdCons = condecls', tcdKindSig = sig,
 481                            tcdDerivs = derivs'},
 482                    plusFVs (map conDeclFVs condecls') `plusFV` deriv_fvs) }
 483
 484   where
 485     is_vanilla = case condecls of       -- Yuk
 486                      []                    -> True
 487                      L _ (ConDecl { con_res = ResTyH98 }) : _  -> True
 488                      other                 -> False
 489
 490     data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
 491     con_names = map con_names_helper condecls
 492
 493     con_names_helper (L _ c) = con_name c
 494
 495     rn_derivs Nothing   = returnM (Nothing, emptyFVs)
 496     rn_derivs (Just ds) = rnLHsTypes data_doc ds        `thenM` \ ds' ->
 497                           returnM (Just ds', extractHsTyNames_s ds')
 498
 499 rnTyClDecl (TySynonym {tcdLName = name, tcdTyVars = tyvars, tcdSynRhs = ty})
 500   = lookupLocatedTopBndrRn name                 `thenM` \ name' ->
 501     bindTyVarsRn syn_doc tyvars                 $ \ tyvars' ->
 502     rnHsTypeFVs syn_doc ty                      `thenM` \ (ty', fvs) ->
 503     returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
 504                         tcdSynRhs = ty'},
 505              delFVs (map hsLTyVarName tyvars') fvs)
 506   where
 507     syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
 508
 509 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
 510                        tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
 511                        tcdMeths = mbinds})
 512   = lookupLocatedTopBndrRn cname                `thenM` \ cname' ->
 513
 514         -- Tyvars scope over superclass context and method signatures
 515     bindTyVarsRn cls_doc tyvars                 ( \ tyvars' ->
 516         rnContext cls_doc context       `thenM` \ context' ->
 517         rnFds cls_doc fds               `thenM` \ fds' ->
 518         renameSigs okClsDclSig sigs     `thenM` \ sigs' ->
 519         returnM   (tyvars', context', fds', sigs')
 520     )   `thenM` \ (tyvars', context', fds', sigs') ->
 521
 522         -- Check the signatures
 523         -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
 524     let
 525         sig_rdr_names_w_locs   = [op | L _ (TypeSig op _) <- sigs]
 526     in
 527     checkDupNames sig_doc sig_rdr_names_w_locs  `thenM_`
 528         -- Typechecker is responsible for checking that we only
 529         -- give default-method bindings for things in this class.
 530         -- The renamer *could* check this for class decls, but can't
 531         -- for instance decls.
 532
 533         -- The newLocals call is tiresome: given a generic class decl
 534         --      class C a where
 535         --        op :: a -> a
 536         --        op {| x+y |} (Inl a) = ...
 537         --        op {| x+y |} (Inr b) = ...
 538         --        op {| a*b |} (a*b)   = ...
 539         -- we want to name both "x" tyvars with the same unique, so that they are
 540         -- easy to group together in the typechecker.
 541     extendTyVarEnvForMethodBinds tyvars' (
 542          getLocalRdrEnv                                 `thenM` \ name_env ->
 543          let
 544              meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
 545              gen_rdr_tyvars_w_locs =
 546                 [ tv | tv <- extractGenericPatTyVars mbinds,
 547                       not (unLoc tv `elemLocalRdrEnv` name_env) ]
 548          in
 549          checkDupNames meth_doc meth_rdr_names_w_locs   `thenM_`
 550          newLocalsRn gen_rdr_tyvars_w_locs      `thenM` \ gen_tyvars ->
 551          rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds
 552     ) `thenM` \ (mbinds', meth_fvs) ->
 553
 554     returnM (ClassDecl { tcdCtxt = context', tcdLName = cname', tcdTyVars = tyvars',
 555                          tcdFDs = fds', tcdSigs = sigs', tcdMeths = mbinds'},
 556              delFVs (map hsLTyVarName tyvars')  $
 557              extractHsCtxtTyNames context'          `plusFV`
 558              plusFVs (map extractFunDepNames (map unLoc fds'))  `plusFV`
 559              hsSigsFVs sigs'                        `plusFV`
 560              meth_fvs)
 561   where
 562     meth_doc = text "In the default-methods for class"  <+> ppr cname
 563     cls_doc  = text "In the declaration for class"      <+> ppr cname
 564     sig_doc  = text "In the signatures for class"       <+> ppr cname
 565
 566 badGadtStupidTheta tycon
 567   = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
 568           ptext SLIT("(You can put a context on each contructor, though.)")]
 569 \end{code}
 570
 571 %*********************************************************
 572 %*                                                      *
 573 \subsection{Support code for type/data declarations}
 574 %*                                                      *
 575 %*********************************************************
 576
 577 \begin{code}
 578 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
 579 rnConDecls tycon condecls
 580   = mappM (wrapLocM rnConDecl) condecls
 581
 582 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
 583 rnConDecl (ConDecl name expl tvs cxt details res_ty)
 584   = do  { addLocM checkConName name
 585
 586         ; new_name <- lookupLocatedTopBndrRn name
 587         ; name_env <- getLocalRdrEnv
 588
 589         -- For H98 syntax, the tvs are the existential ones
 590         -- For GADT syntax, the tvs are all the quantified tyvars
 591         -- Hence the 'filter' in the ResTyH98 case only
 592         ; let not_in_scope  = not . (`elemLocalRdrEnv` name_env) . unLoc
 593               arg_tys       = hsConArgs details
 594               implicit_tvs  = case res_ty of
 595                                 ResTyH98 -> filter not_in_scope $
 596                                                 get_rdr_tvs arg_tys
 597                                 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
 598               tvs' = case expl of
 599                         Explicit -> tvs
 600                         Implicit -> userHsTyVarBndrs implicit_tvs
 601
 602         ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
 603         { new_context <- rnContext doc cxt
 604         ; new_details <- rnConDetails doc details
 605         ; (new_details', new_res_ty)  <- rnConResult doc new_details res_ty
 606         ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty) }}
 607   where
 608     doc = text "In the definition of data constructor" <+> quotes (ppr name)
 609     get_rdr_tvs tys  = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
 610
 611 rnConResult _ details ResTyH98 = return (details, ResTyH98)
 612
 613 rnConResult doc details (ResTyGADT ty) = do
 614     ty' <- rnHsSigType doc ty
 615     let (arg_tys, res_ty) = splitHsFunType ty'
 616         -- We can split it up, now the renamer has dealt with fixities
 617     case details of
 618         PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
 619         RecCon fields -> return (details, ResTyGADT ty')
 620         InfixCon {}   -> panic "rnConResult"
 621
 622 rnConDetails doc (PrefixCon tys)
 623   = mappM (rnLHsType doc) tys   `thenM` \ new_tys  ->
 624     returnM (PrefixCon new_tys)
 625
 626 rnConDetails doc (InfixCon ty1 ty2)
 627   = rnLHsType doc ty1           `thenM` \ new_ty1 ->
 628     rnLHsType doc ty2           `thenM` \ new_ty2 ->
 629     returnM (InfixCon new_ty1 new_ty2)
 630
 631 rnConDetails doc (RecCon fields)
 632   = checkDupNames doc field_names       `thenM_`
 633     mappM (rnField doc) fields          `thenM` \ new_fields ->
 634     returnM (RecCon new_fields)
 635   where
 636     field_names = [fld | (fld, _) <- fields]
 637
 638 rnField doc (name, ty)
 639   = lookupLocatedTopBndrRn name `thenM` \ new_name ->
 640     rnLHsType doc ty            `thenM` \ new_ty ->
 641     returnM (new_name, new_ty)
 642
 643 -- This data decl will parse OK
 644 --      data T = a Int
 645 -- treating "a" as the constructor.
 646 -- It is really hard to make the parser spot this malformation.
 647 -- So the renamer has to check that the constructor is legal
 648 --
 649 -- We can get an operator as the constructor, even in the prefix form:
 650 --      data T = :% Int Int
 651 -- from interface files, which always print in prefix form
 652
 653 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
 654
 655 badDataCon name
 656    = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
 657 \end{code}
 658
 659
 660 %*********************************************************
 661 %*                                                      *
 662 \subsection{Support code to rename types}
 663 %*                                                      *
 664 %*********************************************************
 665
 666 \begin{code}
 667 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
 668
 669 rnFds doc fds
 670   = mappM (wrapLocM rn_fds) fds
 671   where
 672     rn_fds (tys1, tys2)
 673       = rnHsTyVars doc tys1             `thenM` \ tys1' ->
 674         rnHsTyVars doc tys2             `thenM` \ tys2' ->
 675         returnM (tys1', tys2')
 676
 677 rnHsTyVars doc tvs  = mappM (rnHsTyvar doc) tvs
 678 rnHsTyvar doc tyvar = lookupOccRn tyvar
 679 \end{code}
 680
 681
 682 %*********************************************************
 683 %*                                                      *
 684                 Splices
 685 %*                                                      *
 686 %*********************************************************
 687
 688 Note [Splices]
 689 ~~~~~~~~~~~~~~
 690 Consider
 691         f = ...
 692         h = ...$(thing "f")...
 693
 694 The splice can expand into literally anything, so when we do dependency
 695 analysis we must assume that it might mention 'f'.  So we simply treat
 696 all locally-defined names as mentioned by any splice.  This is terribly
 697 brutal, but I don't see what else to do.  For example, it'll mean
 698 that every locally-defined thing will appear to be used, so no unused-binding
 699 warnings.  But if we miss the dependency, then we might typecheck 'h' before 'f',
 700 and that will crash the type checker because 'f' isn't in scope.
 701
 702 Currently, I'm not treating a splice as also mentioning every import,
 703 which is a bit inconsistent -- but there are a lot of them.  We might
 704 thereby get some bogus unused-import warnings, but we won't crash the
 705 type checker.  Not very satisfactory really.
 706
 707 \begin{code}
 708 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
 709 rnSplice (HsSplice n expr)
 710   = do  { checkTH expr "splice"
 711         ; loc  <- getSrcSpanM
 712         ; [n'] <- newLocalsRn [L loc n]
 713         ; (expr', fvs) <- rnLExpr expr
 714
 715         -- Ugh!  See Note [Splices] above
 716         ; lcl_rdr <- getLocalRdrEnv
 717         ; gbl_rdr <- getGlobalRdrEnv
 718         ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
 719                                                     isLocalGRE gre]
 720               lcl_names = mkNameSet (occEnvElts lcl_rdr)
 721
 722         ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
 723
 724 #ifdef GHCI
 725 checkTH e what = returnM ()     -- OK
 726 #else
 727 checkTH e what  -- Raise an error in a stage-1 compiler
 728   = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
 729                   ptext SLIT("illegal in a stage-1 compiler"),
 730                   nest 2 (ppr e)])
 731 #endif
 732 \end{code}